Question

所以这是我最初的问题。答案对于我的问题，似乎是获得UTF-8（和没有BOM的UTF-8）编码的唯一解决方案是使用ADODB.Stream对象。
主题行中我的新问题的答案作为代码发布
我正坐在这里尝试将Save Excel工作表作为.CSV - 文件与VBA宏。
但是，我想知道我是否使用ADODB / ADODB.Stream或.SaveAs Fileformat:=xlCSV是否重要。我试过谷歌它，似乎我找不到哪个方法是最好的＃34;的答案。我需要它以逗号分隔，UTF-8和双引号（＆＃34;＆＃34;）作为文本标识符。

使用Fileformat:=时，SaveAs UTF-8是不正确的，因为xlCSV未使用该编码？ 是，是对的。

此代码将转换您的Excel工作表并将其保存为带有UTF-8的CSV文件，而不使用BOM编码。我在网站上找到了这个代码，所以我不会因此而受到赞扬。 CSV without BOM link

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

' 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
  Next

  'skip BOM
  UTFStream.Position = 3

  'copy UTFStream to BinaryStream
  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

  'Strips BOM (first 3 bytes)
  UTFStream.CopyTo BinaryStream

  UTFStream.Flush
  UTFStream.Close

  'save to file
  BinaryStream.SaveToFile FName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close

End Sub

Answer 1

因此，我遇到了再次需要此代码的情况，并且阅读了注释和伦纳德的回答，这使我可以更新代码并提供更好的描述。

此代码将转换您的Excel工作表，并使用没有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

Answer 2

感谢您发布此问题以及解决方案。这对我帮助很大。是的，我还发现SaveAs不会将CSV文件保存为UTF8。在我的情况下，它使用shift-JIS。 adodb.stream对我很有用。

但是，我不知道为什么，但我必须声明你在代码中使用的一些常量（枚举）。（我对VBA真的很陌生，所以也许我错过了为什么会这样的事情）。我在函数的开头添加了这个，然后它完美地运行了：

  Const adTypeText = 2
  Const adModeReadWrite = 3
  Const adTypeBinary = 1
  Const adLF = 10
  Const adSaveCreateOverWrite = 2
  Const adWriteLine = 1

我从Microsoft docs获得了价值。再一次，谢谢！

如何在VBA（Excel）中使用没有BOM编码的UTF-8保存文本文件（CSV）？

2 个答案: