VBA 将文件保存为 CSV UTF-8 没有 BOM

Question

我使用此代码将我的列表保存为 CSV UTF-8 文件，但它保存为 CSV UTF-8 BOM 文件。

我需要它没有 BOM。我不太擅长编码，所以希望有人能帮我调整代码，所以它将我的列表保存为CSV UTF-8，而没有BOM。

这是我使用的代码：

Sub SaveList_To_CSV()
    Dim MyPath As String, MyFileName As String, rng As Range
    Dim C As Range
    
    MyPath = Sheets("Dashboard").Range("B11").Value 'contain the save location for new file
    MyFileName = Sheets("Dashboard").Range("B14").Value 'contain the name for new file
    
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    
    ActiveWorkbook.Sheets("List_Sheet").Copy 'name of the sheet we want to save as CSV
    Set rng = ActiveWorkbook.Sheets(1).UsedRange
    rng.Offset(0, 1).Clear 'keep only the first column
     
    For Each C In Selection
         If Len(C) = 0 Then C.ClearContents
    Next C
    
    ActiveWorkbook.SaveAs FileName:=MyPath & MyFileName, FileFormat:=xlCSVUTF8, CreateBackup:=False
    ActiveWorkbook.Close
      
    Workbooks.Open FileName:=MyPath & MyFileName
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    
    MsgBox "List Export Successful!"
End Sub

Answer 1

只需一列，您就可以使用 ADODB.Stream 对象创建文件。

ub SaveList_To_CSV()

    Dim MyPath As String, MyFileName As String
    MyPath = Sheets("Dashboard").Range("B11").Value 'contain the save location for new file
    MyFileName = Sheets("Dashboard").Range("B14").Value 'contain the name for new file
    
    If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
    If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
    
    'name of the sheet we want to save as CSV
    Dim rng As Range, s As String
    With ActiveWorkbook.Sheets("List_Sheet")
        Set rng = .UsedRange.Columns(1)
        If rng.Rows.Count = 1 Then
            s = rng.Value
        Else
            s = Join(Application.Transpose(rng), vbCrLf)
        End If
       
    End With
            
    Dim objStreamUTF8, objStreamUTF8NoBOm
    Set objStreamUTF8 = CreateObject("ADODB.Stream")
    Set objStreamUTF8NoBOm = CreateObject("ADODB.Stream")
    
    With objStreamUTF8
        .Charset = "UTF-8"
        .Open
        .Type = 2 'adTypeText
        .WriteText s, 1 'last line crlf
        .Position = 3
    End With

    With objStreamUTF8NoBOm
       .Type = 1 'adTypeBinary
       .Open
       objStreamUTF8.CopyTo objStreamUTF8NoBOm
       .SaveToFile MyPath & MyFileName, 2 'adSaveCreateOverWrite
    End With

    objStreamUTF8.Close
    objStreamUTF8NoBOm.Close
    
    MsgBox rng.Rows.Count & " rows Export Successful! to " & MyPath & MyFileName
End Sub