如何从 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

托尼的答案通常有效，但不处理你的文字包含逗号或引号的情况。 您可能更喜欢使用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包含：

lorem ipsum

绝杀，mps“嗯”

输出csv文件将是：

LOREM，存有

“绝杀，M”， “IPS”， “嗯” “”

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 个循环：一个循环遍历行，一个循环遍历每行的单元格。 每次行循环开始时，临时字符串都会被清空。 在开始新行之前，临时字符串被添加到输出文件中。

子 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

结束子