How to save a text file (CSV) with UTF-8 without BOM encoding in VBA (Excel)?

一个人想着一个人 提交于 2019-12-24 04:21:03

问题


So this was my initial question. The answer to my question below, seems to be that the only solution to get UTF-8 (and UTF-8 without BOM) encoding, is to use the ADODB.Stream object.
The answer to my new question in the subject line is posted as a code.

I am sitting here and trying to Save an Excel sheet as a .CSV-file with a VBA macro.
However, I am wondering if it matters whether I use ADODB/ADODB.Stream or just .SaveAs Fileformat:=xlCSV. I have tried to Google it, and it seems like I cannot find an answer to which method is the "best". I would need it to be comma delimited, UTF-8, and double quotations ("") as text-identifier.

Is it correct that when you use Fileformat:=, it is not possible to SaveAs UTF-8, since the xlCSV is not using that encoding?
YES, that is correct.


This code will convert your Excel sheet and save it as a CSV file with the UTF-8 without BOM encoding. I found this code on a website, so I will not take credit for it. 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

回答1:


thank you for posting this question and also the solution. It helped me a lot. Yes, I also found that SaveAs does not save the CSV file in UTF8. In my case it uses shift-JIS. The adodb.stream worked well for me.

However, I am not sure why but I had to declare some constants (enum) you used in the code. (I am really new to VBA so maybe I missed something about why this happens). I added this in the beginning of the function, then it worked perfectly:

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

I got the value from Microsoft docs. Once again, thanks!



来源:https://stackoverflow.com/questions/29468070/how-to-save-a-text-file-csv-with-utf-8-without-bom-encoding-in-vba-excel

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!