使用 VBA 导出到 CSV - 添加文本限定符

Question

I have a piece of VBA code written that allows user to export table to CSV format (comma separated). Unfortunately one of the columns includes commas in values what breaks the structure when user separating columns by delimiter in excel.

I would not like to write anything from scratch so I was trying and looking for some ways to incorporate text identifiers into my code, but unfortunately found nothing.

Sub save_to_csv()

'Defininf variables
    Dim tbl As ListObject
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim rowArr
    Dim csvVal
    Dim row
    Dim Fldr As String
    Dim CurrTS As String
    
    
    Set ws = Worksheets("Slot_booking_table")
    Set objList = ws.ListObjects("Slot_booking_table")
    
'Current timestamp variable to identify saved CSV files
    CurrTS = CStr(Format(DateTime.Now, "yyyy_MM_dd_hh_mm_ss"))
    
'File dialog to select location where CSV file should be saved
    With Application.FileDialog(4)
      .AllowMultiSelect = False
      .Title = "Select location to save CSV file"
      If .Show <> -1 Then Exit Sub
      Fldr = .SelectedItems(1)
    End With

'Generating CSV file name
    csvFilePath = Fldr & "\slot_booking_" & CurrTS & ".csv"
    
'Loading table to two-dimensional array
    tblArr = objList.Range.Value
    
'Loop for joining each row from array by delimiter
    
    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
        csvVal = VBA.Join(rowArr, ",")
        Print #1, csvVal
    Next
    Close #fNum
    
    MsgBox "CSV file has been generated. Please check the selected location."

    Set tblArr = Nothing
    Set rowArr = Nothing
    Set csvVal = Nothing

End Sub

 

I tried to add For Each loop but it does not help:

Sub save_to_csv()

'Defininf variables
    Dim tbl As ListObject
    Dim ws As Worksheet
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim rowArr
    Dim csvVal
    Dim row
    Dim Fldr As String
    Dim CurrTS As String
    
    
    Set ws = Worksheets("Slot_booking_table")
    Set objList = ws.ListObjects("Slot_booking_table")
    
'Current timestamp variable to identify saved CSV files
    CurrTS = CStr(Format(DateTime.Now, "yyyy_MM_dd_hh_mm_ss"))
    
'File dialog to select location where CSV file should be saved
    With Application.FileDialog(4)
      .AllowMultiSelect = False
      .Title = "Select location to save CSV file"
      If .Show <> -1 Then Exit Sub
      Fldr = .SelectedItems(1)
    End With

'Generating CSV file name
    csvFilePath = Fldr & "\slot_booking_" & CurrTS & ".csv"
    
'Loading table to two-dimensional array
    tblArr = objList.Range.Value
    
'Loop for joining each row from array by delimiter
    
    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
            For Each row In rowArr
               row = """ & row & """
            Next row
        csvVal = VBA.Join(rowArr, ",")
        Print #1, csvVal
    Next
    Close #fNum
    
    MsgBox "CSV file has been generated. Please check the selected location."

    Set tblArr = Nothing
    Set rowArr = Nothing
    Set csvVal = Nothing

End Sub

 

Is there a way to incorporate line with adding text identifier into my code without changing the part of code with joining arrays by delimiter?

Answer 1

It might help to use write instead of print

The documentation to write states:

Unlike the Print # statement, the Write # statement inserts commas between items and quotation marks around strings as they are written to the file.

Answer 2

Please, try replacing this part of your code:

    Open csvFilePath For Output As #fNum
    For i = 1 To UBound(tblArr)
        rowArr = Application.Index(tblArr, i, 0)
            For Each row In rowArr
               row = """ & row & """
            Next row
        csvVal = VBA.Join(rowArr, ",")
        Print #1, csvVal
    Next
    Close #fNum

with this one:

   Dim j As Long, strLine As String, strText As String 'the other variables were declared already...
   For i = 1 To UBound(tblArr)
        For j = 1 To UBound(tblArr, 2)
            strLine = strLine & Chr(34) & tblArr(i, j) & Chr(34) & "," 'build the line string
        Next
        strLine = left(strLine, Len(strLine) - 1) & vbCrLf 'replace the last comma with end of line
        strText = strText & strLine 'add the line to the whole string to be used
        strLine = ""                'reinitialize the line variable
   Next i
   strText = left(strText, Len(strText) - 1) 'replace the ending end of line
   
   fNum = FreeFile()
   Open csvFilePath For Output As #fNum
       Print #fNum, strText 'place the string at once
   Close #fNum