关于Adodb.Stream从UTF-8转到GB2312过程中会多出文字的有关问题

Sub FileZM(sFile As String, sCode As String, dFile As String, dCode As String)
Dim ObjStream As Object

Set ObjStream = CreateObject("Adodb.Stream")
With ObjStream
    .Mode = 3
    .Type = 1
    .Open
    .LoadFromFile sFile

    .Position = 0
    .Type = 2
    .Charset = sCode
    sCode = .ReadText
    
    .Position = 0
    .Type = 2
    .Charset = dCode
    .WriteText sCode
     .SaveToFile dFile, 2
    .Close
End With
Set ObjStream = Nothing

Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As Long)

'如果可选的sytle参数为"hex"， 输出utf8的hex字符串（用于调试和专门目的），否则默认输出的是utf的字符串
Public Function Str_UTF_8(ByVal Str_GB As String, Optional ByVal Sytle As String = "string") As String

    Dim Source() As Byte
    Dim UTF_16 As Long
    Dim Str_Bin As String
    Dim My_utf_Bin As String
    Dim Str_chr As String
    Dim UTF_VAL As Long
    Dim Str_hex As String
    Dim Str_utf_hex As String
    Dim i As Integer
    Dim j As Integer
    Dim nLength As Long
      
    
    For j = 1 To Len(Str_GB)
        CopyMemory UTF_VAL, ByVal StrPtr(Mid(Str_GB, j, 1)), 2      '得到unicode码
        Str_hex = Hex(UTF_VAL)                                      '转为16进制字符串
        Str_Bin = H_To_B(Str_hex, 16)                                  '转为2进制字符串
      
        If UTF_VAL < &H80 Then                                            ' 1 UTF-8 byte 英文字符
            My_utf_Bin = Mid(Str_Bin, 9, 8)
        ElseIf UTF_VAL < &H800 Then                                       ' 2 UTF-8 bytes   非英文字符
            My_utf_Bin = "110" + Mid(Str_Bin, 5, 5) + "10" + Mid(Str_Bin, 11, 6)
        Else                                                              ' 3 UTF-8 bytes
            My_utf_Bin = "1110" + Mid(Str_Bin, 1, 4) + "10" + Mid(Str_Bin, 5, 6) + "10" + Mid(Str_Bin, 11, 6)
        End If
        Str_utf_hex = Str_utf_hex + B_To_H(My_utf_Bin)            '转为utf8的16进制字符串
    Next j

    nLength = Len(Str_utf_hex) / 2
    ReDim Source(Len(Str_utf_hex) / 2)

    For i = 1 To Len(Str_utf_hex) Step 2
        CopyMemory Source((i + 1) / 2), ByVal StrPtr(ChrB("&h" + Mid(Str_utf_hex, i, 2))), 1
        Str_chr = Str_chr & ChrB(Source((i + 1) / 2))
    Next i
    If Sytle = "hex" Or Sytle = "Hex" Or Sytle = "HEX" Then                '判断是不是要输出机器码
        Str_UTF_8 = Str_utf_hex
    Else
        Str_UTF_8 = Str_chr
    End If
       
End Function
'二进制转16进制函数
Public Function B_To_H(ByVal Bininary_in As String) As String
    Dim i As Long
    Dim H As String
    If Len(Bininary_in) Mod 4 <> 0 Then
        Bininary_in = String(4 - Len(Bininary_in) Mod 4, "0") & Bininary_in
    End If
      
    For i = 1 To Len(Bininary_in) Step 4
        Select Case Mid(Bininary_in, i, 4)
            Case "0000": H = H & "0"
            Case "0001": H = H & "1"
            Case "0010": H = H & "2"
            Case "0011": H = H & "3"
            Case "0100": H = H & "4"
            Case "0101": H = H & "5"
            Case "0110": H = H & "6"
            Case "0111": H = H & "7"
            Case "1000": H = H & "8"
            Case "1001": H = H & "9"
            Case "1010": H = H & "A"
            Case "1011": H = H & "B"
            Case "1100": H = H & "C"
            Case "1101": H = H & "D"
            Case "1110": H = H & "E"
            Case "1111": H = H & "F"
        End Select
    Next i
    B_To_H = H
End Function
'16进制转二进制函数
Public Function H_To_B(ByVal hex_str As String, MinimumDigits As Integer) As String
    Dim i As Long
    Dim B As String
    Dim ExtraDigitsNeeded As Integer
    hex_str = UCase(hex_str)
    For i = 1 To Len(hex_str)
        Select Case Mid(hex_str, i, 1)
            Case "0": B = B & "0000"
            Case "1": B = B & "0001"
            Case "2": B = B & "0010"
            Case "3": B = B & "0011"
            Case "4": B = B & "0100"
            Case "5": B = B & "0101"
            Case "6": B = B & "0110"
            Case "7": B = B & "0111"
            Case "8": B = B & "1000"
            Case "9": B = B & "1001"
            Case "A": B = B & "1010"
            Case "B": B = B & "1011"
            Case "C": B = B & "1100"
            Case "D": B = B & "1101"
            Case "E": B = B & "1110"
            Case "F": B = B & "1111"
        End Select
    Next i

    ExtraDigitsNeeded = MinimumDigits - Len(B)
    If ExtraDigitsNeeded > 0 Then
        B = String(ExtraDigitsNeeded, "0") & B
    End If
    H_To_B = B
End Function