Excel VBA：不使用ADODB.Stream保存无BOM大文本文件的方法？

因为Scripting.FileSystemObject的CreateTextFile无法直接生成无BOM的UTF-8文件，且大文件场景下Windows API调用效率更高，以下是完全不依赖ADODB.Stream的实现方案：

实现代码 #

Option Explicit

' Windows API声明
Private Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" _
    (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As LongPtr) As LongPtr

Private Declare PtrSafe Function WriteFile Lib "kernel32" _
    (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long

Private Declare PtrSafe Function CloseHandle Lib "kernel32" _
    (ByVal hObject As LongPtr) As Long

Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const CREATE_ALWAYS As Long = 2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80

Sub SaveUTF8NoBOM(ByVal filePath As String, ByVal content As String)
    Dim hFile As LongPtr
    Dim utf8Bytes() As Byte
    Dim bytesWritten As Long
    
    ' 将VBA字符串（Unicode）转换为无BOM的UTF-8字节数组
    utf8Bytes = UnicodeToUTF8(content)
    
    ' 创建文件（覆盖已有文件）
    hFile = CreateFile(filePath, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    
    If hFile <> -1 Then
        ' 写入UTF-8字节流
        WriteFile hFile, utf8Bytes(0), UBound(utf8Bytes) + 1, bytesWritten, ByVal 0&
        ' 关闭文件句柄
        CloseHandle hFile
    End If
End Sub

' 手动实现Unicode到UTF-8的编码转换（无BOM）
Private Function UnicodeToUTF8(ByVal unicodeStr As String) As Byte()
    Dim utf8List As Collection
    Dim charCode As Long
    Dim i As Long
    
    Set utf8List = New Collection
    
    For i = 1 To Len(unicodeStr)
        charCode = AscW(Mid(unicodeStr, i, 1))
        
        Select Case charCode
            Case 0 To &H7F
                ' 单字节UTF-8
                utf8List.Add CByte(charCode)
            Case &H80 To &H7FF
                ' 双字节UTF-8
                utf8List.Add CByte(&HC0 Or (charCode \ &H40))
                utf8List.Add CByte(&H80 Or (charCode And &H3F))
            Case &H800 To &HFFFF
                ' 三字节UTF-8
                utf8List.Add CByte(&HE0 Or (charCode \ &H1000))
                utf8List.Add CByte(&H80 Or ((charCode \ &H40) And &H3F))
                utf8List.Add CByte(&H80 Or (charCode And &H3F))
        End Select
    Next i
    
    ' 将集合转换为字节数组
    ReDim result(0 To utf8List.Count - 1) As Byte
    For i = 0 To utf8List.Count - 1
        result(i) = utf8List(i + 1)
    Next i
    
    UnicodeToUTF8 = result
End Function

' 调用示例
Sub TestSaveLargeFile()
    Dim largeContent As String
    ' 替换为你的大文本内容
    largeContent = "这里是需要保存的大文件内容..."
    
    SaveUTF8NoBOM "C:\YourPath\File.txt", largeContent
End Sub

方案优势 #

• 完全脱离ADODB.Stream依赖，纯API+手动编码实现
• 大文件场景下，API直接写入的速度远优于FSO和ADODB.Stream的常规写法
• 生成的文件严格为无BOM的UTF-8编码

内容的提问来源于stack exchange，提问作者Per