Question

好的，所以我想在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

但现在问题是：在我的工作表中有一些包含逗号的单元格。如果我使用上面显示的宏，文件将保存为CSV，但包含逗号的单元格在它们周围有引号。我不要那个。如果我通过文件手动保存文件 - ＆gt;另存为 - ＆gt; CSV / TXT，生成的文件不包含这些引号。

有谁知道如何解决这个问题？

非常感谢！

编辑：我忘了说，手动保存时，我选择文本标签分隔，而不是逗号分隔。

Answer 1

好的，让我们看看我在阁楼里有什么......

我有一个适合账单的VBA 数组到文件功能：你正在做的工作可能有点过分，因为你不需要标题行，转置和检查的选项具有错误陷阱的预先存在的文件，该错误陷阱读取文件的日期戳并防止重复调用该函数不断覆盖该文件。但这是我必须提供的代码，简化它比使用它更麻烦。

你做想要的是这个函数默认使用Tab字符作为字段分隔符。当然，您可以将其设置为逗号... csv文件的常用定义是由逗号和文本字段（可能包含逗号字符）分隔的字段，这些字段用双引号括起来。但我无法宣称能证明这种迂腐的道德制高点，因为下面的代码并没有强加封装引号。

编码备注：

您需要对Windows Scripting Runtime Library的引用：scrrun.dll - 这可以在系统文件夹（通常是C：\ WINDOWS \ system32）中找到 - 因为我们正在使用文件系统对象;
ArrayToFile将数据写入临时文件夹中的指定文件。如果指定'CopyFilePath'，则会将其复制到其他位置：永远不要写入网络文件夹，写入本地驱动器并使用本机文件系统函数移动或复制已完成的文件总是更快;
数据以块的形式写入文件，而不是逐行;
还有进一步优化的余地：使用Split和Join函数可以消除循环中的字符串连接;
您可能希望将VbCrLF用作行分隔符而不是VbCr：回车通常可以正常工作，但某些系统和应用程序需要Carriage-Return-and-LineFeed组合才能正确读取或显示换行符。

使用ArrayToFile函数：

这很简单：只需输入工作表使用范围的.Value2属性：



   ArrayToFile Worksheets("Sheet1").UsedRange.Value2, "MyData.csv"

'Value2'的原因是'Value'属性捕获格式，您可能想要日期字段的基础序列值。

VBA ArrayToFile函数的源代码：

分享并享受...并注意有用的换行符，插入可以通过浏览器破坏代码的任何地方（或通过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 &lt; 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 &lt; 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 &lt; 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

为了完整性，这里是从文件读入数组的补充函数，以及用于清理临时文件的粗略准备子程序：

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


' **** **** **** 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 &lt; 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 &lt; 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 &lt; 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
Application.StatusBar = "Copying " & strName & " to " & CopyFilePath & "..."
objFSO.CopyFile strFile, CopyFilePath, True

我建议你把它保存在Option Private Module下的模块中 - 这不是我希望其他用户直接从工作表调用的那种功能。

Answer 2

这是不可能的（有点）。

包含分隔符的字段必须用引号括起来。否则，该字段将被分隔符“撕成两半”。

唯一的解决方案是使用不同的分隔符，例如制表符（有效地将其更改为TSV文件），当然，只有在数据中没有出现新的分隔符时才有效。

Answer 3

如果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

如何将Excel工作表另存为CSV以便导出的文件中不包含引号？

3 个答案: