没用过,帮顶

怎么没有人会呢?!

自己搞定了！

帮顶

你自己搞定怎么就不说下怎么搞的。
我也遇到这类问题。。。寻找解决方案

楼主不厚道。

谁说我不厚道！！！
^-^
private sub cmdTest_click()
    dim sStr as string
    Open App.Path & "\Model\head" For Input As #1
        Input #1, sStr 
    Close #1
    Call SaveToUTF8(sStr)
end sub 

Private Sub SaveToUTF8(sStr as string)
On Error GoTo OutError
Dim DAT() As Byte, DAT1() As Byte, ST As String
Dim Z As String
Dim zTem As String
Dim zCod As String
Dim zHex As String
Dim zBin As String
Dim zRes As Long
Dim zAsc As Long
Dim L As Long, 字节计数
Dim i1 As Long
Dim i2 As Integer
Dim sFileName As String

For i1 = 1 To Len(sStr)
    Z = Mid(sStr, i1, 1): zAsc = Asc(Z)
    If zAsc > 0 Then '如果不是汉字
        ReDim Preserve DAT(L + 1) As Byte
        DAT(L) = zAsc: L = L + 1
    Else
        ReDim Preserve DAT(L + 3) As Byte
        DAT1 = Z: ST = Right("0" & Hex(DAT1(1)), 2) & Right("0" & Hex(DAT1(0)), 2)
        For i2 = 1 To Len(ST)
            Z = Mid(ST, i2, 1)
            Select Case Z '将汉字的16进制Unicode编码转换为二进制的
                Case Is = "0": zBin = zBin & "0000"
                Case Is = "1": zBin = zBin & "0001"
                Case Is = "2": zBin = zBin & "0010"
                Case Is = "3": zBin = zBin & "0011"
                Case Is = "4": zBin = zBin & "0100"
                Case Is = "5": zBin = zBin & "0101"
                Case Is = "6": zBin = zBin & "0110"
                Case Is = "7": zBin = zBin & "0111"
                Case Is = "8": zBin = zBin & "1000"
                Case Is = "9": zBin = zBin & "1001"
                Case Is = "A": zBin = zBin & "1010"
                Case Is = "B": zBin = zBin & "1011"
                Case Is = "C": zBin = zBin & "1100"
                Case Is = "D": zBin = zBin & "1101"
                Case Is = "E": zBin = zBin & "1110"
                Case Is = "F": zBin = zBin & "1111"
            End Select
        Next
        zTem = "1110" & Left(zBin, 4) & "10" & Mid(zBin, 5, 6) & "10" & Right(zBin, 6)
        For i2 = 1 To 24
            Z = Mid(zTem, i2, 1)
            zRes = zRes + IIf(Z = "1", 1 * 2 ^ (24 - i2), 0 * 2 ^ (24 - i2))
        Next
        Z = Hex(zRes) '汉字已转换为3字节的16进制数据
        DAT(L) = val("&H" & Left(Z, 2))
        DAT(L + 1) = val("&H" & Mid(Z, 3, 2))
        DAT(L + 2) = val("&H" & Right(Z, 2))
        L = L + 3
    End If
    zBin = "": zRes = 0
Next
ReDim DAT1(2) As Byte
DAT1(0) = &HEF: DAT1(1) = &HBB: DAT1(2) = &HBF

CdlgEOP.filename = ""
CdlgEOP.ShowOpen

sFileName = Trim(CdlgEOP.filename)
If sFileName = "" Then Exit Sub
DAT(UBound(DAT)) = 32

Open sFileName For Binary As #1
    Put #1, , DAT1
    Put #1, , DAT
Close #1
OutError:
Close
End Sub