如何从 VBA 创建单独的 CSV 文件？

Question

我需要将一些结果输出为 .csv 文件，稍后由另一个进程对其进行解析。为了产生这些结果，我有一个巨大的工作簿，其中包含我需要的所有宏和函数。

1. 是否可以从 VBA“创建”一个单独的 .csv 文件？
2. 是否可以使用 VBA 功能将其写入其中，而不仅仅是以“原始文本”方式写入？

Answer 1

你想要这样的东西吗？

Option Explicit
Sub WriteFile()

  Dim ColNum As Integer
  Dim Line As String
  Dim LineValues() As Variant
  Dim OutputFileNum As Integer
  Dim PathName As String
  Dim RowNum As Integer
  Dim SheetValues() As Variant

  PathName = Application.ActiveWorkbook.Path
  OutputFileNum = FreeFile

  Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum

  Print #OutputFileNum, "Field1" & "," & "Field2"

  SheetValues = Sheets("Sheet1").Range("A1:H9").Value
  ReDim LineValues(1 To 8)

  For RowNum = 1 To 9
    For ColNum = 1 To 8
      LineValues(ColNum) = SheetValues(RowNum, ColNum)
    Next
    Line = Join(LineValues, ",")
    Print #OutputFileNum, Line
  Next

  Close OutputFileNum

End Sub

不要忘记，您需要在任何包含逗号的字段周围加上引号。

Answer 2

Tony 的回答通常有效，但不能处理您的文本包含逗号或引号的情况。您可能更喜欢使用 Workbook.SaveAs 方法。

如果您想将 Sheet1 的内容保存为单独的 csv 文件，这里是一个示例。

Sub create_csv()
    Dim FileName As String
    Dim PathName As String
    Dim ws As Worksheet

    Set ws = ActiveWorkbook.Sheets("Sheet1")
    FileName = "filename.csv"
    PathName = Application.ActiveWorkbook.Path
    ws.Copy
    ActiveWorkbook.SaveAs FileName:=PathName & "\" & FileName, _
        FileFormat:=xlCSV, CreateBackup:=False
End Sub

想象一下您的 Sheet1 包含：

判断题

lore,m ips“嗯”

输出的 csv 文件将是：

lorem,ipsum

"lore,m","ips""um"""

Answer 3

您可以编写一个宏，例如从 VBA 以 CSV 格式保存当前工作簿（打开的 excel 文件）：

ActiveWorkbook.SaveAs Filename:="C:\Book1.csv", _
    FileFormat:=xlCSVMSDOS, CreateBackup:=False

Answer 4

对于那些手动编写 CSV 的人，您需要处理逗号、双引号和换行符。

例如

Sub WriteToCsv(Items() as String)

    OutFile = FreeFile          
    Open "Outfile.csv" For Output As #OutFile
    
    Print #OutFile, "Header"
    
    For Each Item In Items       
        If InStr(1, Item, Chr(34)) > 0 Then Item = Chr(34) & Replace(Item, Chr(34), Chr(34) & Chr(34)) & Chr(34)
        If InStr(1, Item, ",") > 0 And Left(Item, 1) <> Chr(34) Then Item = Chr(34) & Item & Chr(34)
        If InStr(1, Item, vbLf) > 0 And Left(Item, 1) <> Chr(34) Then Item = Chr(34) & Item & Chr(34)
        Print #OutFile, Item
    Next
    
    Close OutFile

End Sub

Answer 5

以您的代码为基础（谢谢！！！）但必须对其进行修改才能使其正常工作。 它没有处理多行，所有单元格都被放置在彼此之后。 2个循环：一个遍历行，一个遍历每行的单元格。 每次行循环开始时，临时字符串都会被清空。在开始新行之前，将临时字符串添加到 Outfile。

Sub ToCsv()

Dim rng As Range
Dim row As Range
Dim cell As Range

Dim ItemNew As String

Set rng = Range("A1:E2")    'Adjust the range accordingly

OutFile = FreeFile
Open "Outfile.csv" For Output As #OutFile

'Print #OutFile, "Header"

For Each row In rng.Rows
    ItemNew = ""
    For Each Item In row.Cells
        If InStr(1, Item, Chr(34)) > 0 Then Item = Chr(34) & Replace(Item, Chr(34), Chr(34) & Chr(34)) & Chr(34)
        If InStr(1, Item, ",") > 0 And Left(Item, 1) <> Chr(34) Then Item = Chr(34) & Item & Chr(34)
        If InStr(1, Item, vbLf) > 0 And Left(Item, 1) <> Chr(34) Then Item = Chr(34) & Item & Chr(34)
        If ItemNew = "" Then
            ItemNew = Item
        Else
            ItemNew = ItemNew & "," & Item
        End If
    Next
    Print #OutFile, ItemNew
Next
Close OutFile

End Sub