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

Question

我编写了一段 VBA 代码，允许用户将表导出为 CSV 格式（逗号分隔）。 不幸的是，其中一列在值中包含逗号，当用户在 excel 中通过分隔符分隔列时，会破坏结构。

我不想从头开始写任何东西，所以我试图寻找一些方法将文本标识符合并到我的代码中，但不幸的是什么也没找到。

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

 

我尝试添加 For Each 循环，但没有帮助：

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

 

有没有办法通过分隔符加入 arrays 来将添加文本标识符的行合并到我的代码中而不更改代码部分？

Answer 1

使用write而不是print可能会有所帮助

要编写的文档指出：

与 Print # 语句不同，Write # 语句在将字符串写入文件时在项目和引号之间插入逗号。

Answer 2

请尝试替换这部分代码：

    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

有了这个：

   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