首页 > 解决方案 > 将 TXT 文件保存为不带 BOM 的 UTF-8

问题描述

一切正常,但是代码用 BOM 用 UTF-8 创建了一个 txt 文件,我想用 UTF-8 创建一个 txt,但没有 BOM。

我怎样才能做到这一点?

Option Explicit

Sub SaveWorkSheetAsCSV()
    
    ActiveSheet.Buttons.Delete
    
    Dim FolderPath As String
    FolderPath = "C:\Users\" & Environ("USERNAME") & "\Test"
    
    Dim FileName As String: FileName = Format(Now, "yyyymmdd-hh.mm ") & " Test file"
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(4)
    
    Application.ScreenUpdating = False
    
    sws.Copy
    Dim dwb As Workbook: Set dwb = ActiveWorkbook
    
    Application.DisplayAlerts = False
    dwb.SaveAs FolderPath & "\" & FileName & ".txt", xlCSVUTF8, Local:=True
    Application.DisplayAlerts = True
    dwb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    ThisWorkbook.FollowHyperlink FolderPath

End Sub

标签: excelvba

解决方案


要删除 BOM,请将文件读入 ADODB 流对象,将位置移动 3 个字节,然后使用另一个流将字节保存到新文件中。

    dwb.Close SaveChanges:=False 
    Call RemoveBOM(FolderPath, filename) ' add this line to your code
    ThisWorkbook.FollowHyperlink FolderPath

添加这个子

Sub RemoveBOM(FolderPath As String, filename As String)

    Dim objStreamUTF8, objStreamUTF8NoBOm
    Set objStreamUTF8 = CreateObject("ADODB.Stream")
    Set objStreamUTF8NoBOm = CreateObject("ADODB.Stream")
    
    With objStreamUTF8
        .Charset = "UTF-8"
        .Open
        .LoadFromFile FolderPath & "\" & filename & ".txt"
        .Type = 2 'adTypeText
        .Position = 3
    End With

    With objStreamUTF8NoBOm
       .Type = 1 'adTypeBinary
       .Open
       objStreamUTF8.CopyTo objStreamUTF8NoBOm
       .SaveToFile FolderPath & "\" & filename & "_noBOM.txt", 2 'adSaveCreateOverWrite
    End With

    objStreamUTF8.Close
    objStreamUTF8NoBOm.Close

End Sub

推荐阅读