vba 如何将 Excel 工作表另存为 CSV，以便导出的文件中不包含引号？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12051221/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to save an Excel sheet as CSV so that no quotes are contained in the exported file?
提问by Alex
Okay, so I want to have a macro in Excel 2003 which saves the current worksheet as a .txt file. I've already got that part with the following code:
好的，所以我想在 Excel 2003 中有一个宏，它将当前工作表保存为 .txt 文件。我已经使用以下代码获得了该部分：
Dim filename As String
Dim path As String
filename = InputBox("Please enter file name", "Save as CSV", "CSV_" & Format(Now, "DD_MM_yyyy"))
path = "C:\Temp" & filename & ".txt"
ActiveWorkbook.SaveAs filename:=path, FileFormat:=xlTextMSDOS, CreateBackup:=False
But now to the actual problem: In my sheet there are some cells which contain a comma. If I use the macro shown above, the file gets saved as CSV, but the cells containing a comma have quotation marks around them. I do not want that. If I save the file manually via File -> Save as -> CSV/TXT, the resulting file does not contain these quotation marks.
但是现在到实际问题：在我的工作表中有一些包含逗号的单元格。如果我使用上面显示的宏，文件将保存为 CSV，但包含逗号的单元格周围有引号。我不要那个。如果我通过文件 -> 另存为 -> CSV/TXT 手动保存文件，则生成的文件不包含这些引号。
Does anyone know how to solve this problem?
有谁知道如何解决这个问题？
Many thanks!
非常感谢！
Edit: I forgot to say that, when saving manually, I select Text tab-seperated, and not comma-seperated.
编辑：我忘了说，手动保存时，我选择文本制表符分隔，而不是逗号分隔。
回答by Nigel Heffernan
OK, Let's see what I've got in the attic...
好吧，让我们看看我在阁楼上有什么……
I have a VBA Array To Filefunction which fits the bill: probably overkill for the work you're doing, as you don't need the options for header rows, transposing, and checking for pre-existing files with an error-trap that reads the file's datestamp and prevents repeated calls to the function continually overwriting the file. But it's the code I've got to hand, and simplifying it is more trouble than using it as-is.
我有一个符合要求的 VBA Array To File函数：可能对你正在做的工作来说太过分了，因为你不需要标题行、转置和检查带有错误陷阱的预先存在的文件的选项读取文件的日期戳并防止重复调用函数不断覆盖文件。但这是我必须掌握的代码，简化它比按原样使用更麻烦。
The thing you dowant is that this function uses the Tab character as a field delimiter by default. You could, of course, set it to the comma... The commonly-accepted definition of csv file is fields delimited by commas and text fields (which may contain the comma character) encapsulated in double-quotes. But I can't claim the moral high ground that would justify this kind of pedantry, because the code below doesn't impose the encapsulating quotes.
你的东西都希望是这个函数使用制表符作为默认字段分隔符。当然，您可以将其设置为逗号... csv 文件的普遍接受的定义是由逗号分隔的字段和封装在双引号中的文本字段（可能包含逗号字符）。但是我不能声称可以证明这种迂腐的道德制高点，因为下面的代码没有强加封装引号。
Coding Notes:
编码说明：
- You need a reference to the Windows Scripting Runtime Library: scrrun.dll - this can be found in the system folder (usually C:\WINDOWS\system32) - as we're using the File System Object;
- ArrayToFile writes the data to your named file in the temp folder. If you specify 'CopyFilePath', this will be copied elsewhere: never write to a network folder, it's always faster to write to a local drive and use the native file system functions to move or copy the finished file;
- Data is written to the file in blocks, instead of line-by-line;
- There is scope for further optimisation: using Split and Join functions would eliminate the string concatenations in the loops;
- You might want to use VbCrLF as a row delimiter instead of VbCr: carriage returns usually work but some systems and applications need the Carriage-Return-and-LineFeed combination in order to read or display line breaks correctly.
- 您需要引用 Windows 脚本运行时库：scrrun.dll - 这可以在系统文件夹（通常是 C:\WINDOWS\system32）中找到 - 因为我们正在使用文件系统对象；
- ArrayToFile 将数据写入临时文件夹中的命名文件。如果您指定“CopyFilePath”，这将被复制到其他地方：永远不要写入网络文件夹，写入本地驱动器并使用本机文件系统功能移动或复制完成的文件总是更快；
- 数据以块为单位写入文件，而不是逐行写入；
- 有进一步优化的余地：使用 Split 和 Join 函数将消除循环中的字符串连接；
- 您可能希望使用 VbCrLF 作为行分隔符而不是 VbCr：回车通常有效，但某些系统和应用程序需要 Carriage-Return-and-LineFeed 组合才能正确读取或显示换行符。
This is easy: just feed in the .Value2 property of the sheet's used range:
这很简单：只需输入工作表使用范围的 .Value2 属性：
ArrayToFile Worksheets("Sheet1").UsedRange.Value2, "MyData.csv"
The reason for 'Value2' is that the 'Value' property captures formatting, and you probably want the underlying serial values of date fields.
'Value2' 的原因是 'Value' 属性捕获格式，并且您可能需要日期字段的基础序列值。
Source code for the VBA ArrayToFile function:
VBA ArrayToFile 函数的源代码：
Share and Enjoy... And watch out for helpful line breaks, inserted wherever they can break the code by your browser (or by StackOverflow's helpful formatting functions):
分享和享受......并注意有用的换行符，插入任何可以通过浏览器（或通过 StackOverflow 的有用格式功能）破坏代码的地方：
Public Sub ArrayToFile(ByVal arrData As Variant, _
ByVal strName As String, _
Optional MinFileAge As Double = 0, _
Optional Transpose As Boolean = False, _
Optional RowDelimiter As String = vbCr, _
Optional FieldDelimiter = vbTab, _
Optional CopyFilePath As String, _
Optional NoEmptyRows As Boolean = True, _
Optional arrHeader1 As Variant, _
Optional arrHeader2 As Variant)
' Output an array to a file. The field delimiter is tab (char 9); rows use CarriageReturn(char 13).
' The file will be named as specified by strName, and saved in the user's Windows Temp folder.
' Specify CopyFilePath (the full name and path) to copy this temporary file to another folder.
' Saving files locally and copying them is much faster than writing data across the network.
' If a Min File Age 'n' is specified, and n is greater than zero, an existing file will not be
' replaced, and no data will be written unless the file is more than MinFileAge seconds old.
' Transpose = TRUE is useful for arrays generated by Recordset.GetRows and ListControl.Column
' Note that ADODB.Recordset has a native 'save' method (rows delimited by VbCr, fields by Tab)
' **** This code is in the Public Domain **** Nigel Heffernan http://Excellerando.blogspot.com
On Error Resume Next
Dim objFSO As Scripting.FileSystemObject
Set objFSO = New Scripting.FileSystemObject
If objFSO Is Nothing Then
Shell "Regsvr32.exe /s scrrun.dll", vbHide
Application.Wait Now + (0.25 / 3600 / 24)
Set objFSO = CreateObject("Scripting.FileSystemObject")
End If
If objFSO Is Nothing Then
Exit Sub
End If
Dim strFile As String
Dim strTemp As String
Dim i As Long, j As Long
Dim strData As String
Dim strLine As String
Dim strEmpty As String
Dim dblCount As Double
Const BUFFERLEN As Long = 255
strName = Replace(strName, "[", "")
strName = Replace(strName, "]", "")
Set objFSO = New Scripting.FileSystemObject
If objFSO Is Nothing Then
Shell "Regsvr32.exe /s scrrun.dll", vbHide
Application.Wait Now + (0.25 / 3600 / 24)
Set objFSO = CreateObject("Scripting.FileSystemObject")
End If
If objFSO Is Nothing Then
Exit Sub
End If
strTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPath
strFile = objFSO.BuildPath(strTemp, strName)
If objFSO.FileExists(strFile) Then
If MinFileAge > 0 Then
If objFSO.GetFile(strFile).DateCreated + (MinFileAge / 3600 / 24) > Now Then
Set objFSO = Nothing
Exit Sub
End If
End If
Err.Clear
objFSO.DeleteFile strFile, True
If Err.Number = 70 Then
VBA.FileSystem.Kill strFile
End If
End If
If objFSO.FileExists(strFile) Then
Exit Sub
End If
Application.StatusBar = "Cacheing data in a temp file... "
strData = vbNullString
With objFSO.OpenTextFile(strFile, ForWriting, True)
' **** **** **** HEADER1 **** **** ****
If Not IsMissing(arrHeader1) Then
If Not IsEmpty(arrHeader1) Then
If InStr(1, TypeName(arrHeader1), "(") > 1 Then ' It's an array...
Select Case ArrayDimensions(arrHeader1)
Case 1 ' Vector array
.Write Join(arrHeader1, RowDelimiter)
Case 2 ' 2-D array... 3-D arrays are not handled
If Transpose = True Then
For i = LBound(arrHeader1, 2) To UBound(arrHeader1, 2)
For j = LBound(arrHeader1, 1) To UBound(arrHeader1, 1)
strData = strData & FieldDelimiter & CStr(arrHeader1(j, i))
Next j
strData = strData & RowDelimiter
Next i
Else ' not transposing:
For i = LBound(arrHeader1, 1) To UBound(arrHeader1, 1)
For j = LBound(arrHeader1, 2) To UBound(arrHeader1, 2)
strData = strData & CStr(arrHeader1(i, j))
If j < UBound(arrHeader1, 2) Then
strData = strData & FieldDelimiter
End If
Next j
strData = strData & RowDelimiter
Next i
End If ' Transpose
End Select
' .Write strData
' strData = vbNullString
Erase arrHeader1
Else ' treat it as a string
If LenB(arrHeader1) > 0 Then
.Write arrHeader1
End If
End If
End If 'Not IsMissing(arrHeader1)
End If 'Not IsEmpty(arrHeader1)
' **** **** **** HEADER2 **** **** ****
If Not IsMissing(arrHeader2) Then
If Not IsEmpty(arrHeader2) Then
If InStr(1, TypeName(arrHeader2), "(") > 1 Then ' It's an array...
Select Case ArrayDimensions(arrHeader2)
Case 1 ' Vector array
.Write Join(arrHeader2, RowDelimiter)
Case 2 ' 2-D array... 3-D arrays are not handled
If Transpose = True Then
For i = LBound(arrHeader2, 2) To UBound(arrHeader2, 2)
For j = LBound(arrHeader2, 1) To UBound(arrHeader2, 1)
strData = strData & FieldDelimiter & CStr(arrHeader2(j, i))
Next j
strData = strData & RowDelimiter
Next i
Else ' not transposing:
For i = LBound(arrHeader2, 1) To UBound(arrHeader2, 1)
For j = LBound(arrHeader2, 2) To UBound(arrHeader2, 2)
strData = strData & CStr(arrHeader2(i, j))
If j < UBound(arrHeader2, 2) Then
strData = strData & FieldDelimiter
End If
Next j
strData = strData & RowDelimiter
Next i
End If ' Transpose
End Select
' .Write strData
' strData = vbNullString
Erase arrHeader2
Else ' treat it as a string
If LenB(arrHeader2) > 0 Then
.Write arrHeader2
End If
End If
End If 'Not IsMissing(arrHeader2)
End If 'Not IsEmpty(arrHeader2)
' **** **** **** BODY **** **** ****
If InStr(1, TypeName(arrData), "(") > 1 Then
' It's an array...
Select Case ArrayDimensions(arrData)
Case 1
If NoEmptyRows Then
.Write Replace$(Join(arrData, RowDelimiter), RowDelimiter & RowDelimiter, "")
Else
.Write Join(arrData, RowDelimiter)
End If
Case 2
If Transpose = True Then
strEmpty = String(UBound(arrData, 1) - 1, FieldDelimiter) & RowDelimiter
For i = LBound(arrData, 2) To UBound(arrData, 2)
For j = LBound(arrData, 1) To UBound(arrData, 1)
strData = strData & FieldDelimiter & CStr(arrData(j, i))
Next j
strData = strData & RowDelimiter
If (Len(strData) \ 1024) > BUFFERLEN Then
If NoEmptyRows Then
strData = Replace$(strData, strEmpty, "")
'strData = Replace$(strData, RowDelimiter & RowDelimiter, "")
End If
Application.StatusBar = "Cacheing data in a temp file... (" & Format(dblCount + (Len(strData) \ 1024), "0,000") & "kB)"
dblCount = dblCount + (Len(strData) \ 1024)
.Write strData
strData = vbNullString
End If
Next i
Else ' not transposing:
strEmpty = String(UBound(arrData, 2) - 1, FieldDelimiter) & RowDelimiter
For i = LBound(arrData, 1) To UBound(arrData, 1)
For j = LBound(arrData, 2) To UBound(arrData, 2)
strData = strData & CStr(arrData(i, j))
If j < UBound(arrData, 2) Then
strData = strData & FieldDelimiter
End If
Next j
strData = strData & RowDelimiter
If (Len(strData) \ 1024) > BUFFERLEN Then
If NoEmptyRows Then
strData = Replace$(strData, strEmpty, "")
'strData = Replace$(strData, RowDelimiter & RowDelimiter, "")
End If
Application.StatusBar = "Cacheing data in a temp file... (" & Format(dblCount + (Len(strData) \ 1024), "0,000") & "kB)"
dblCount = dblCount + (Len(strData) \ 1024)
.Write strData
strData = vbNullString
End If
Next i
End If ' Transpose
End Select
If NoEmptyRows Then
strData = Replace$(strData, strEmpty, "")
'strData = Replace$(strData, RowDelimiter & RowDelimiter, "")
End If
If Right$(strData, Len(RowDelimiter)) = RowDelimiter Then
Mid$(strData, Len(strData) - Len(RowDelimiter), Len(RowDelimiter)) = ""
End If
.Write strData
strData = vbNullString
Erase arrData
Else ' treat it as a string
.Write arrData
End If
.Close
End With ' textstream object from objFSO.OpenTextFile
If CopyFilePath <> "" Then
Application.StatusBar = "Copying " & strName & " to " & CopyFilePath & "..."
objFSO.CopyFile strFile, CopyFilePath, True
End If
Application.StatusBar = False
Set objFSO = Nothing
strData = vbNullString
End Sub
For completeness, here's the complementary function that reads from files into an array, and a rough-and-ready subroutine to clean up your temp files:
为了完整起见，这里是从文件读取到数组的补充函数，以及用于清理临时文件的粗略子程序：
Public Sub FileToArray(arrData As Variant, strName As String, Optional MaxFileAge As Double = 0, Optional RowDelimiter As String = vbCr, Optional FieldDelimiter = vbTab, Optional CoerceLowerBound As Long = 0) ' Load a file created by FileToArray into a 2-dimensional array ' The file name is specified by strName, and it is exected to exist in the user's temporary folder. ' This is a deliberate restriction: it's always faster to copy remote files to a local drive than to edit them across the network ' If a Max File Age 'n' is specified, and n is greater than zero, files more than n seconds old will NOT be read.
' **** This code is in the Public Domain **** Nigel Heffernan http://Excellerando.blogspot.com
On Error Resume Next
Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject
If objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject") End If
If objFSO Is Nothing Then Exit Sub End If
Dim strFile As String Dim strTemp As String
Dim i As Long Dim j As Long
Dim i_n As Long Dim j_n As Long
Dim i_lBound As Long Dim i_uBound As Long Dim j_lBound As Long Dim j_uBound As Long
Dim arrTemp1 As Variant Dim arrTemp2 As Variant
Dim dblCount As Double
Set objFSO = New Scripting.FileSystemObject
If objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject") End If
If objFSO Is Nothing Then Exit Sub End If
strTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPath
strFile = objFSO.BuildPath(strTemp, strName)
If Not objFSO.FileExists(strFile) Then Exit Sub End If
If MaxFileAge > 0 Then ' If the file's a bit elderly, bail out - the calling function will refresh the data from source If objFSO.GetFile(strFile).DateCreated + (MaxFileAge / 3600 / 24) < Now Then Set objFSO = Nothing Exit Sub End If
End If
Application.StatusBar = "Reading the file... (" & strName & ")"
arrData = Split2d(objFSO.OpenTextFile(strFile, ForReading).ReadAll, RowDelimiter, FieldDelimiter, CoerceLowerBound)
Application.StatusBar = "Reading the file... Done"
Set objFSO = Nothing
End Sub
Public Sub RemoveTempFiles(ParamArray FileNames())
On Error Resume Next
Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject
If objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject") End If
If objFSO Is Nothing Then Exit Sub End If
Dim varName As Variant Dim strName As String Dim strFile As String Dim strTemp As String
strTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPath
For Each varName In FileNames
strName = vbNullString strFile = vbNullString strName = CStr(varName) strFile = objFSO.BuildPath(strTemp, strName) If objFSO.FileExists(strFile) Then objFSO.DeleteFile strFile, True End IfNext varName
Set objFSO = Nothing
End Sub
I'd advise you to keep this in a module under Option Private Module - this isn't the kind of function I'd want other users calling from a worksheet directly.
我建议您将其保留在 Option Private Module 下的模块中 - 这不是我希望其他用户直接从工作表调用的那种功能。
回答by Tim Pietzcker
This is impossible (sort of).
这是不可能的（有点）。
A field that contains the delimiter must be enclosed in quotes. Otherwise, that field would be "torn in two" by the delimiter.
包含分隔符的字段必须用引号括起来。否则，该字段将被分隔符“一分为二”。
The only solution is to use a different delimiter, for example tabs (effectively changing it to a TSV file), which of course only works if that new delimiter doesn't occur in the data either.
唯一的解决方案是使用不同的分隔符，例如制表符（有效地将其更改为 TSV 文件），这当然只有在数据中也没有出现新的分隔符时才有效。
回答by chris neilsen
If none of the SaveAsformats work for you, write your parser, eg
如果没有一种SaveAs格式适合您，请编写您的解析器，例如
Sub SaveFile()
Dim rng As Range
Dim rw As Range
Dim ln As Variant
' Set rng to yout data range, eg
Set rng = ActiveSheet.UsedRange
Open "C:\Temp\TESTFILE.txt" For Output As #1 ' Open file for output.
For Each rw In rng.Rows
ln = Join(Application.Transpose(Application.Transpose(rw)), vbTab)
Print #1, ln; vbNewLine;
Next
Close #1
End Sub
