如何将Excel表单保存为CSV，以便导出的文件中不包含引号？ [英] How to save an Excel sheet as CSV so that no quotes are contained in the exported file?
问题描述
好的，所以我想在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 < UBound（arrHeader1，2）then
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 < UBound（arrHeader2，2）then
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 < UBound（arrData，2）then
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 bApplication.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 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:=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:
Using the ArrayToFile function:
- 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.
This is easy: just feed in the .Value2 property of the sheet's used range:
The reason for 'Value2' is that the 'Value' property captures formatting, and you probably want the underlying serial values of date fields.ArrayToFile Worksheets("Sheet1").UsedRange.Value2, "MyData.csv"
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.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 IfEnd 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, TrueEnd 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.
这篇关于如何将Excel表单保存为CSV，以便导出的文件中不包含引号？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
