如何将Excel表单保存为CSV，以便导出的文件中不包含引号？

本文介绍了如何将Excel表单保存为CSV，以便导出的文件中不包含引号？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 好的，所以我想在Excel 2003中有一个宏，将当前工作表保存为.txt文件。我已经有这个部分与下面的代码： Dim filename As String Dim路径As String filename = InputBox（请输入文件名，另存为CSV，CSV_和格式（现在为DD_MM_yyyy）） path =C：\ Temp&文件名.txt ActiveWorkbook.SaveAs filename：= path，FileFormat：= xlTextMSDOS，CreateBackup：= False 但现在的实际问题：在我的表中有一些单元格包含逗号。如果我使用上面显示的宏，文件将被保存为CSV，但包含逗号的单元格周围有引号。我不要那个。 如果我通过文件 - >另存为 - > CSV / TXT手动保存文件，则生成的文件不包含这些引号。 有人知道如何解决这个问题？ 非常感谢！ 编辑：我忘记说， 解决方案确定，让我们看看我在attic ... 我有一个VBA 数组到文件函数，适合条例草案：可能过度杀死你正在做的工作，您不需要标题行的选项，转置和检查预先存在的文件，使用读取文件的日期戳记的错误陷阱，并防止重复调用该函数不断覆盖文件。但是它是我必须要的代码，并且简化它比使用它是更麻烦。 你做的事想要的是，此函数默认使用Tab字符作为字段分隔符。您当然可以将其设置为逗号... csv文件的通常接受的定义是由逗号和文本字段（可能包含逗号字符）分隔的字段封装在双引号中。但我不能说道德的高地，这将证明这种方法，因为下面的代码不强加封装的引号。 编码注释 您需要对Windows Scripting运行时库的引用：scrrun.dll - 这可以在系统文件夹中找到（通常是C：\WINDOWS\\ \\ system32） - 因为我们正在使用文件系统对象; ArrayToFile将数据写入您的temp文件夹中的命名文件。如果指定CopyFilePath，则会将其复制到其他位置：从不写入网络文件夹，写入本地驱动器并使用本机文件系统函数移动或复制完成的文件总是更快; 数据以块而不是逐行的方式写入文件; 有进一步优化的余地：使用拆分和连接函数将消除字符串连接在循环中; 您可能想使用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，_ 可选MinFileAge As Double = 0，_ 可选Transpose As Boolean = False，_ 可选RowDelimiter As String = vbCr，_ 可选FieldDelimiter = vbTab，_ 可选CopyFilePath As String，_ 可选NoEmptyRows As Boolean = True，_ 可选arrHeader1 As Variant，_ 可选arrHeader2 As Variant） '将数组输出到文件。字段分隔符是tab（char 9）; rows使用CarriageReturn（char 13）。 '该文件将按照strName指定，并保存在用户的Windows Temp文件夹中。 '指定CopyFilePath（全名和路径）将此临时文件复制到另一个文件夹。 '在本地保存文件并复制它们比在网络上写数据要快很多。 n，并且n大于零，则现有文件不会被替换为'，除非该文件超过MinFileAge秒，否则不会写入任何数据。 p> 'Transpose = TRUE对于由Recordset.GetRows和ListControl.Column生成的数组很有用'请注意，ADODB.Recordset有一个本地的save方法by VbCr，by Tab） ' **此代码位于公共领域** Nigel Heffernan http://Excellerando.blogspot.com 出错时继续下一步 Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject 如果objFSO不是$ b ShellRegsvr32.exe / s scrrun.dll，vbHide Application.Wait Now +（0.25 / 3600/24）设置objFSO = CreateObject（Scripting.FileSystemObject）结束If 如果objFSO不存在则退出子结束如果 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，] ，） 设置objFSO =新的Scripting.FileSystemObject 如果objFSO是Nothing然后 ShellRegsvr32.exe / s scrrun.dll，vbHide Application.Wait Now +（0.25 / 3600/24）设置objFSO = CreateObject（Scripting.FileSystemObject） End If 如果objFSO不存在则退出子结束If strTemp = objFSO .GetSpecialFolder（Scripting.TemporaryFolder）.ShortPath strFile = objFSO.BuildPath（strTemp，strName） objFSO.FileExists（strFile）Then 如果MinFileAge> 0 Then If objFSO.GetFile（strFile）.DateCreated +（MinFileAge / 3600/24）>现在然后设置objFSO =没有退出Sub 结束如果结束如果 Err.Clear objFSO.DeleteFile strFile，True 如果Err.Number = 70则 VBA.FileSystem.Kill strFile 结束如果 结束If 如果objFSO.FileExists（strFile）then 退出Sub 结束If Application.StatusBar =在临时文件中缓存数据... strData = vbNullString 使用objFSO .OpenTextFile（strFile，ForWriting，True） '**** **** **** HEADER1 *** * **** **** 如果不是IsMissing（arrHeader1）则如果不是IsEmpty（arrHeader1）则如果InStr（1，TypeName（arrHeader1），（）> ; 1 Then'It's a array ... 选择案例ArrayDimensions（arrHeader1）案例1'向量数组 .Write Join（arrHeader1，RowDelimiter） 情况2'2-D数组...不处理3-D数组 如果Transpose = True然后 对于i = LBound arrHeader1，2）到UBound（arrHeader1,2） 对于j = LBound（arrHeader1,1）到UBound（arrHeader1,1） strData = strData& FieldDelimiter& CStr（arrHeader1（j，i）） 接下来j strData = strData& RowDelimiter Next i 否则不转置： 对于i = LBound（arrHeader1，1）到UBound（arrHeader1，1） For j = LBound（arrHeader1，2）To UBound（arrHeader1，2） strData = strData& CStr（arrHeader1（i，j）） 如果j strData = strData& FieldDelimiter End If Next j strData = strData& RowDelimiter Next i 结束If'Transpose 结束选择 '.Write strData 'strData = vbNullString 擦除arrHeader1 否则将其视为字符串如果LenB（arrHeader1）> 0 Then .Write arrHeader1 结束如果结束如果结束If'Not IsMissing（arrHeader1）结束If'Not IsEmpty（arrHeader1） '**** **** **** HEADER2 **** **** **** 如果非IsMissing（arrHeader2）然后如果不是IsEmpty（arrHeader2）然后如果InStr（1，TypeName（arrHeader2），（）> 1那么'它是一个数组... 选择案例ArrayDimensions arrHeader2）情况1'向量数组 .Write连接（arrHeader2，RowDelimiter） 情况2'2-D数组... 3-D数组未处理 如果Transpose = True然后 对于i = LBound（arrHeader2,2）到UBound（arrHeader2，2） 对于j = LBound（arrHeader2，1）到UBound（arrHeader2,1） strData = strData& FieldDelimiter& CStr（arrHeader2（j，i）） Next j strData = strData& RowDelimiter 接下来的i 否则不转置： 对于i = LBound（arrHeader2， 1）到UBound（arrHeader2，1） 对于j = LBound（arrHeader2,2）到UBound（arrHeader2,2） strData = strData& CStr（arrHeader2（i，j）） 如果j strData = strData& FieldDelimiter End If Next j strData = strData& RowDelimiter Next i 结束If'Transpose 结束选择 '.Write strData 'strData = vbNullString 擦除arrHeader2 否则将其视为字符串如果LenB（arrHeader2）> 0 Then .Write arrHeader2 结束如果结束如果结束If'Not IsMissing（arrHeader2）结束If'不IsEmpty（arrHeader2） '**** **** **** BODY **** * *** **** 如果InStr（1，TypeName（arrData），（）> 1 then '这是一个数组... 选择案例ArrayDimensions（arrData）案例1 如果NoEmptyRows then .Write替换$（Join（arrData，RowDelimiter），RowDelimiter& RowDelimiter，） Else .Write Join（arrData，RowDelimiter）结束如果 情况2 如果Transpose = True然后 strEmpty = String（UBound（arrData，1）-1，FieldDelimiter）& RowDelimiter For i = LBound（arrData，2）到UBound（arrData，2） For j = LBound（arrData，1）To UBound（arrData，1） strData = strData& FieldDelimiter& CStr（arrData（j，i）） 接下来j strData = strData& RowDelimiter If（Len（strData）\ 1024）> BUFFERLEN then 如果NoEmptyRows then strData = Replace $（strData，strEmpty，）'strData = Replace $（strData，RowDelimiter& RowDelimiter，） End If Application.StatusBar =缓存临时文件中的数据...（& Format（dblCount +（Len（strData）\ 1024），0,000）& ;kB） dblCount = dblCount +（Len（strData）\ 1024） .Write strData strData = vbNullString End If 接下来的i 否则不转置： strEmpty = String（UBound（arrData，2）-1，FieldDelimiter）& RowDelimiter 对于i = LBound（arrData，1）到UBound（arrData，1） 对于j = LBound（arrData，2） b $ b strData = strData& CStr（arrData（i，j）） 如果j strData = strData& FieldDelimiter End If Next j strData = strData& RowDelimiter If（Len（strData）\ 1024）> BUFFERLEN then 如果NoEmptyRows then strData = Replace $（strData，strEmpty，）'strData = Replace $（strData，RowDelimiter& RowDelimiter，） End If Application.StatusBar =缓存临时文件中的数据...（& Format（dblCount +（Len（strData）\ 1024），0,000）& ;kB） dblCount = dblCount +（Len（strData）\ 1024） .Write strData strData = vbNullString End If 下一个i 结束如果'转置 结束选择 如果NoEmptyRows则 strData = Replace $（strData， strEmpty，）'strData = Replace $（strData，RowDelimiter& RowDelimiter，）如果 结束如果Right $（strData，Len（RowDelimiter） = RowDelimiter Then Mid $（strData，Len（strData） - Len（RowDelimiter），Len（RowDelimiter））=结束如果 strData strData = vbNullString 擦除arrData 否则将其视为字符串 .Write arrData End If 。关闭结束于objFSO.OpenTextFile 如果CopyFilePath<>然后 Application.StatusBar =复制& strName& 至& CopyFilePath& ... objFSO.CopyFile strFile，CopyFilePath，True Application.StatusBar = False 设置objFSO =无 strData = vbNullString 为了完整起见，这里有一个补充功能，数组和一个粗略准备的子程序来清理临时文件： 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）'将FileToArray创建的文件加载到2维数组'文件名由strName指定，并且它被存在于用户的临时文件夹中。 '这是一个有意的限制：将远程文件复制到本地驱动器比在网络上编辑它总是更快'如果指定了最大文件年龄'n'，并且n大于 ' **此代码位于公共域名 Nigel Heffernan a href =http://Excellerando.blogspot.com =nofollow> http://Excellerando.blogspot.com 发生错误继续下一步 Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject objFSO is Nothing然后 ShellRegsvr32.exe / s scrrun.dll，vbHide Application.Wait Now +（0.25 / 3600/24）设置objFSO = CreateObject（Scripting.FileSystemObject ）结束If 如果objFSO不是则退出Sub 结束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 设置objFSO =新的Scripting.FileSystemObject Nothing Then ShellRegsvr32.exe / s scrrun.dll，vbHide Application.Wait Now +（0.25 / 3600/24）设置objFSO = CreateObject（Scripting.FileSystemObject） 结束If 如果objFSO不存在则退出子结束If strTemp = objFSO.GetSpecialFolder（Scripting.TemporaryFolder）.ShortPath strFile = objFSO.BuildPath（strTemp，strName） 如果不是objFSO.FileExists（strFile）则退出Sub 结束如果 如果MaxFileAge> 0 then '如果文件有点老了，保护 - 调用函数将从源刷新数据如果objFSO.GetFile（strFile）.DateCreated +（MaxFileAge / 3600/24）<现在然后设置objFSO =没有退出Sub 结束如果 结束如果 $ b b Application.StatusBar =读取文件...（& strName&） arrData = Split2d（objFSO.OpenTextFile（strFile， ForReading）.ReadAll，RowDelimiter，FieldDelimiter，CoerceLowerBound） Application.StatusBar =读取文件...完成 Set objFSO = Nothing End Sub Public Sub RemoveTempFiles（ParamArray FileNames / p> 错误后继续下一步 Dim objFSO As Scripting.FileSystemObject Set objFSO = New Scripting.FileSystemObject 如果objFSO不是，则 ShellRegsvr32.exe / s scrrun.dll，vbHide Application.Wait Now +（0.25 / 3600 / 24）设置objFSO = CreateObject（Scripting.FileSystemObject）结束如果 如果objFSO不是则退出子结束If Dim varName As Variant Dim strName As String Dim strFile As String Dim strTemp As String strTemp = objFSO.GetSpecialFolder（Scripting.TemporaryFolder）.ShortPath 对于FileName中的每个varName strName = vbNullString strFile = vbNullString strName = CStr（varName） strFile = objFSO.BuildPath（strTemp，strName） 如果objFSO.FileExists（strFile）然后 objFSO.DeleteFile strFile，True 结束如果 下一页varName 设置objFSO = Nothing 结束子 我建议你保存在一个模块下的Option私人模块 - 这不是我想要的其他用户从工作表直接调用的那种功能。 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:Dim filename As StringDim path As Stringfilename = 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:=FalseBut 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.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. 解决方案 OK, Let's see what I've got in the attic...I have a VBA Array To File function 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.The thing you do want 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.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.Using the ArrayToFile function:This is easy: just feed in the .Value2 property of the sheet's used range: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.Source code for the VBA ArrayToFile function: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):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.comOn Error Resume NextDim objFSO As Scripting.FileSystemObjectSet objFSO = New Scripting.FileSystemObjectIf objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject")End IfIf objFSO Is Nothing Then Exit SubEnd IfDim strFile As StringDim strTemp As StringDim i As Long, j As LongDim strData As StringDim strLine As StringDim strEmpty As StringDim dblCount As DoubleConst BUFFERLEN As Long = 255strName = Replace(strName, "[", "")strName = Replace(strName, "]", "")Set objFSO = New Scripting.FileSystemObjectIf objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject")End IfIf objFSO Is Nothing Then Exit SubEnd IfstrTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPathstrFile = objFSO.BuildPath(strTemp, strName)If objFSO.FileExists(strFile) ThenIf MinFileAge > 0 Then If objFSO.GetFile(strFile).DateCreated + (MinFileAge / 3600 / 24) > Now Then Set objFSO = Nothing Exit Sub End IfEnd IfErr.ClearobjFSO.DeleteFile strFile, TrueIf Err.Number = 70 Then VBA.FileSystem.Kill strFileEnd IfEnd IfIf objFSO.FileExists(strFile) Then Exit SubEnd IfApplication.StatusBar = "Cacheing data in a temp file... "strData = vbNullStringWith objFSO.OpenTextFile(strFile, ForWriting, True)' **** **** **** HEADER1 **** **** ****If Not IsMissing(arrHeader1) ThenIf Not IsEmpty(arrHeader1) ThenIf 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 arrHeader1Else ' treat it as a string If LenB(arrHeader1) > 0 Then .Write arrHeader1 End IfEnd IfEnd If 'Not IsMissing(arrHeader1)End If 'Not IsEmpty(arrHeader1)' **** **** **** HEADER2 **** **** ****If Not IsMissing(arrHeader2) ThenIf Not IsEmpty(arrHeader2) ThenIf 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 arrHeader2Else ' treat it as a string If LenB(arrHeader2) > 0 Then .Write arrHeader2 End IfEnd IfEnd 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 arrDataElse ' treat it as a string .Write arrDataEnd If.CloseEnd With ' textstream object from objFSO.OpenTextFileIf CopyFilePath <> "" ThenApplication.StatusBar = "Copying " & strName & " to " & CopyFilePath & "..."objFSO.CopyFile strFile, CopyFilePath, TrueEnd IfApplication.StatusBar = FalseSet objFSO = NothingstrData = vbNullStringEnd SubFor 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.comOn Error Resume NextDim objFSO As Scripting.FileSystemObjectSet objFSO = New Scripting.FileSystemObjectIf objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject")End IfIf objFSO Is Nothing Then Exit SubEnd IfDim strFile As StringDim strTemp As StringDim i As LongDim j As LongDim i_n As LongDim j_n As LongDim i_lBound As LongDim i_uBound As LongDim j_lBound As LongDim j_uBound As LongDim arrTemp1 As VariantDim arrTemp2 As VariantDim dblCount As DoubleSet objFSO = New Scripting.FileSystemObjectIf objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject")End IfIf objFSO Is Nothing Then Exit SubEnd IfstrTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPathstrFile = objFSO.BuildPath(strTemp, strName)If Not objFSO.FileExists(strFile) Then Exit SubEnd IfIf 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 IfEnd IfApplication.StatusBar = "Reading the file... (" & strName & ")"arrData = Split2d(objFSO.OpenTextFile(strFile, ForReading).ReadAll, RowDelimiter, FieldDelimiter, CoerceLowerBound)Application.StatusBar = "Reading the file... Done"Set objFSO = NothingEnd SubPublic Sub RemoveTempFiles(ParamArray FileNames())On Error Resume NextDim objFSO As Scripting.FileSystemObjectSet objFSO = New Scripting.FileSystemObjectIf objFSO Is Nothing Then Shell "Regsvr32.exe /s scrrun.dll", vbHide Application.Wait Now + (0.25 / 3600 / 24) Set objFSO = CreateObject("Scripting.FileSystemObject")End IfIf objFSO Is Nothing Then Exit SubEnd IfDim varName As VariantDim strName As StringDim strFile As StringDim strTemp As StringstrTemp = objFSO.GetSpecialFolder(Scripting.TemporaryFolder).ShortPathFor Each varName In FileNamesstrName = vbNullStringstrFile = vbNullStringstrName = CStr(varName)strFile = objFSO.BuildPath(strTemp, strName)If objFSO.FileExists(strFile) Then objFSO.DeleteFile strFile, TrueEnd IfNext varNameSet objFSO = NothingEnd SubI'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. 这篇关于如何将Excel表单保存为CSV，以便导出的文件中不包含引号？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！