如何在 VBA (Excel) 中保存没有 BOM 编码的 UTF-8 文本文件 (CSV)?
How to save a text file (CSV) with UTF-8 without BOM encoding in VBA (Excel)?
所以这是我最初的问题。 下面我的问题的答案,似乎是获得 UTF-8(和没有 BOM 的 UTF-8)编码的唯一解决方案是使用 ADODB.Stream 对象。
主题行中我的新问题的答案作为代码发布。
我坐在这里并尝试将 Save
一个 Excel sheet 作为一个 .CSV
文件 VBA 宏.
但是,我想知道我使用 ADODB
/ADODB.Stream
还是只使用 .SaveAs
Fileformat:=xlCSV
是否重要。我试过 Google 它,但似乎找不到 "best" 是哪种方法的答案。我需要它以逗号分隔、UTF-8 和双引号 ("") 作为文本标识符。
当您使用 Fileformat:=
时,无法使用 SaveAs
UTF-8 是否正确,因为 xlCSV
未使用该编码? 是的,这是正确的。
请参阅我的答案以获取解决方案。
感谢您发布此问题以及解决方案。这对我帮助很大。
是的,我还发现 SaveAs 不会以 UTF8 格式保存 CSV 文件。在我的例子中,它使用 shift-JIS。 adodb.stream 对我来说效果很好。
但是,我不确定为什么我不得不声明一些您在代码中使用的常量(枚举)。 (我真的是 VBA 的新手,所以也许我错过了一些关于为什么会发生这种情况的信息)。我在函数的开头添加了这个,然后它完美地工作:
Const adTypeText = 2
Const adModeReadWrite = 3
Const adTypeBinary = 1
Const adLF = 10
Const adSaveCreateOverWrite = 2
Const adWriteLine = 1
我从 Microsoft 文档中获取了值。
再次感谢!
所以我又遇到了需要这段代码的情况,我阅读了评论和 Leonard 的回答,这让我更新了我的代码以及更好的描述。
此代码将转换您的 Excel sheet 并将其保存为不带 BOM 编码的 UTF-8 CSV 文件。我在网站上找到了这段代码,所以我不会以此为荣。 CSV without BOM link
Option Explicit
Sub CSVFileAsUTF8WithoutBOM()
Dim SrcRange As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim UTFStream As Object
Dim BinaryStream As Object
' ADO Constants
Const adTypeBinary = 1 ' The stream contains binary data
Const adTypeText = 2 ' The stream contains text data (default)
Const adWriteLine = 1 ' write text string and a line separator (as defined by the LineSeparator property) to the stream.
Const adModeReadWrite = 3 ' Read/write
Const adLF = 10 ' Line feed only - default is carriage return line feed (adCRLF)
Const adSaveCreateOverWrite = 2 ' Overwrites the file with the data from the currently open Stream object, if the file already exists
' Open this workbook location
ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path
' ask for file name and path
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
' prepare UTF-8 stream
Set UTFStream = CreateObject("adodb.stream")
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
UTFStream.LineSeparator = adLF
UTFStream.Open
'set field separator
ListSep = ";"
'set source range with data for csv file
If Selection.Cells.Count > 1 Then
Set SrcRange = Selection
Else
Set SrcRange = ActiveSheet.UsedRange
End If
For Each CurrRow In SrcRange.Rows
'enclose each value with quotation marks and escape quotation marks in values
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & """" & Replace(CurrCell.Value, """", """""") & """" & ListSep
Next
'remove ListSep after the last value in line
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
'add line to UTFStream
UTFStream.WriteText CurrTextStr, adWriteLine ' Writes character data to a text Stream object
Next
'skip BOM
UTFStream.Position = 3 ' sets or returns a long value that indicates the current position (in bytes) from the beginning of a Stream object
'copy UTFStream to BinaryStream
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open ' Opens a Stream object
'Strips BOM (first 3 bytes)
UTFStream.CopyTo BinaryStream ' Copies a specified number of characters/bytes from one Stream object into another Stream object
UTFStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
UTFStream.Close ' Closes a Stream object
'save to file
BinaryStream.SaveToFile FName, adSaveCreateOverWrite
BinaryStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
BinaryStream.Close ' Closes a Stream object
End Sub
所以这是我最初的问题。 下面我的问题的答案,似乎是获得 UTF-8(和没有 BOM 的 UTF-8)编码的唯一解决方案是使用 ADODB.Stream 对象。
主题行中我的新问题的答案作为代码发布。
我坐在这里并尝试将 Save
一个 Excel sheet 作为一个 .CSV
文件 VBA 宏.
但是,我想知道我使用 ADODB
/ADODB.Stream
还是只使用 .SaveAs
Fileformat:=xlCSV
是否重要。我试过 Google 它,但似乎找不到 "best" 是哪种方法的答案。我需要它以逗号分隔、UTF-8 和双引号 ("") 作为文本标识符。
当您使用 Fileformat:=
时,无法使用 SaveAs
UTF-8 是否正确,因为 xlCSV
未使用该编码? 是的,这是正确的。
请参阅我的答案以获取解决方案。
感谢您发布此问题以及解决方案。这对我帮助很大。 是的,我还发现 SaveAs 不会以 UTF8 格式保存 CSV 文件。在我的例子中,它使用 shift-JIS。 adodb.stream 对我来说效果很好。
但是,我不确定为什么我不得不声明一些您在代码中使用的常量(枚举)。 (我真的是 VBA 的新手,所以也许我错过了一些关于为什么会发生这种情况的信息)。我在函数的开头添加了这个,然后它完美地工作:
Const adTypeText = 2
Const adModeReadWrite = 3
Const adTypeBinary = 1
Const adLF = 10
Const adSaveCreateOverWrite = 2
Const adWriteLine = 1
我从 Microsoft 文档中获取了值。 再次感谢!
所以我又遇到了需要这段代码的情况,我阅读了评论和 Leonard 的回答,这让我更新了我的代码以及更好的描述。
此代码将转换您的 Excel sheet 并将其保存为不带 BOM 编码的 UTF-8 CSV 文件。我在网站上找到了这段代码,所以我不会以此为荣。 CSV without BOM link
Option Explicit
Sub CSVFileAsUTF8WithoutBOM()
Dim SrcRange As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
Dim UTFStream As Object
Dim BinaryStream As Object
' ADO Constants
Const adTypeBinary = 1 ' The stream contains binary data
Const adTypeText = 2 ' The stream contains text data (default)
Const adWriteLine = 1 ' write text string and a line separator (as defined by the LineSeparator property) to the stream.
Const adModeReadWrite = 3 ' Read/write
Const adLF = 10 ' Line feed only - default is carriage return line feed (adCRLF)
Const adSaveCreateOverWrite = 2 ' Overwrites the file with the data from the currently open Stream object, if the file already exists
' Open this workbook location
ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path
' ask for file name and path
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
' prepare UTF-8 stream
Set UTFStream = CreateObject("adodb.stream")
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
UTFStream.LineSeparator = adLF
UTFStream.Open
'set field separator
ListSep = ";"
'set source range with data for csv file
If Selection.Cells.Count > 1 Then
Set SrcRange = Selection
Else
Set SrcRange = ActiveSheet.UsedRange
End If
For Each CurrRow In SrcRange.Rows
'enclose each value with quotation marks and escape quotation marks in values
CurrTextStr = ""
For Each CurrCell In CurrRow.Cells
CurrTextStr = CurrTextStr & """" & Replace(CurrCell.Value, """", """""") & """" & ListSep
Next
'remove ListSep after the last value in line
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
'add line to UTFStream
UTFStream.WriteText CurrTextStr, adWriteLine ' Writes character data to a text Stream object
Next
'skip BOM
UTFStream.Position = 3 ' sets or returns a long value that indicates the current position (in bytes) from the beginning of a Stream object
'copy UTFStream to BinaryStream
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open ' Opens a Stream object
'Strips BOM (first 3 bytes)
UTFStream.CopyTo BinaryStream ' Copies a specified number of characters/bytes from one Stream object into another Stream object
UTFStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
UTFStream.Close ' Closes a Stream object
'save to file
BinaryStream.SaveToFile FName, adSaveCreateOverWrite
BinaryStream.Flush ' Sends the contents of the Stream buffer to the associated underlying object
BinaryStream.Close ' Closes a Stream object
End Sub