011集—vba代码将汉字用(utf-8)编码写入文本文档

        在vba中，根据提供字符串（包含汉字等符号）可以得出相应的utf-8对应的十六进制编码，代码如下   ：

'2024年2月28日17:30:55 qq:443440204 
Public Function StringToUtf8ByteArray(ByVal filePath As String, s As String) As Byte()
    Dim i As Long, j As Long
    Dim result() As Byte
    Dim charCode As Integer
    Dim bytesRequired As Integer
    Dim char As String
      
    ' 初始化数组以容纳至少一个字符（单字节）
    ReDim result(0)
      
    ' 遍历字符串中的每个字符
    For i = 1 To Len(s)
        char = Mid(s, i, 1) ' 获取单个字符
        charCode = AscW(char)
          
        ' 根据字符的 Unicode 码点确定所需的字节数
        If charCode < 128 Then
            ' 单字节字符
            bytesRequired = 1
        ElseIf charCode < 2048 Then
            ' 双字节字符
            bytesRequired = 2
        ElseIf charCode < 65536 Then
            ' 三字节字符
            bytesRequired = 3
        Else
            ' 不支持的字符（超出三字节范围）
            MsgBox "字符串包含不支持的 UTF-8 字符。"
            Exit Function
        End If
          
        ' 如果当前数组空间不足，则扩展它
        If UBound(result) + bytesRequired > i - 1 Then
            If i = 1 Then
                ReDim Preserve result(bytesRequired - 1)
             Else
                ReDim Preserve result(i + bytesRequired - 1)
            End If
        End If
          
        ' 将字符的 UTF-8 编码写入数组
    
'            result(i + j - 1) = 0 ' 清除任何现有数据
            Select Case bytesRequired
                Case 1
                    result(i) = charCode
                Case 2
                    result(i + 1) = 192 + (charCode \ 64)
                    result(i) = 128 + (charCode Mod 64)
                Case 3
                    result(i - 1) = 224 + (charCode \ (64 * 64))
                    result(i) = 128 + ((charCode Mod (64 * 64)) \ 64)
                    result(i + 1) = 128 + (charCode Mod 64)
            End Select
     
        ' 更新索引以反映已写入的字节数
'        i = i + bytesRequired
    Next i
      
    ' 重新定义数组大小以移除未使用的空间
'    ReDim Preserve result(UBound(result) - (UBound(result) - i + 1))
'
'    ' 返回字节数组
    StringToUtf8ByteArray = result

End Function
  
' 将文本追加到 UTF-8 编码的文件中的子程序
 Sub AppendTextToUtf8File()
    Dim filePath As String
    Dim fileNo As Integer
    Dim textToAppend As String
    Dim UTF8Bytes() As Byte
    Dim i As Long
    Dim mychar As String, myhex As String
    ' 设置文件路径
    filePath = "D:\ZD\1111.txt" ' 替换为你的文件路径
    fileNo = FreeFile()
    Open filePath For Binary As #fileNo
    ' 要追加的文本（汉字“你好”）
    textToAppend = "大社区"
     For i = 1 To Len(textToAppend)
         mychar = Mid(textToAppend, i, 1)
          
        ' 将文本转换为 UTF-8 字节数组
        UTF8Bytes = StringToUtf8ByteArray(filePath, mychar)
        ' 写入 UTF-8 字节到文件
        For j = LBound(UTF8Bytes) To UBound(UTF8Bytes)
            Put #fileNo, LOF(fileNo) + 1, UTF8Bytes(j)
            myhex = myhex & Hex(UTF8Bytes(j)) & Chr(32)
        Next j
      Next i
      
    ' 关闭文件
    Close #fileNo
 
      
    ' 可选：显示消息框以确认操作
    MsgBox textToAppend & "的UTF-8编码是 " & myhex, , "版权@qq443440204"
End Sub