VBA调用XMLHTTP POST上传XML文件至API服务及UTF-8乱码问题

完全可以通过Excel VBA的MSXML2.ServerXMLHTTP库实现multipart/form-data格式的XML文件上传，你遇到的UTF-8乱码是请求体构造时的编码转换逻辑错误导致的，修正后即可正常运行。

你现有代码的问题出在两处编码逻辑：

• 读取XML文件原始字节后，用StrConv(baBuffer, vbUnicode)按系统默认ANSI编码（中文系统通常为GBK）把字节转成VBA内部的UTF-16字符串，直接破坏了原始UTF-8文件的字节结构
• 后续用StrConv(sText, vbFromUnicode)把拼接好的字符串转回字节时，同样按系统默认ANSI编码转换，UTF-8的多字节特殊字符会被错误映射，最终上传的文件内容必然乱码

构造multipart/form-data请求体时全程以字节数组为单位操作，避免对二进制文件内容做任何编码转换：

• 分隔符、Content-Disposition等ASCII格式的请求头文本，统一转成UTF-8编码的字节数组
• XML文件直接读取原始字节，不做任何字符串转换，完全保留原始UTF-8编码
• 把「开头分隔符头字节 + XML原始字节 + 结尾分隔符字节」拼接成完整的请求体字节数组，直接发送
• 移除无效的Accept-Charset请求头，该头仅用于声明期望的响应编码，和上传文件的编码无关

Option Explicit

Sub UploadFile()
    Dim sFile As String
    Dim sUrl As String
    Dim sAccessToken As String
    Dim sBoundary As String
    Dim sResponse As String
    
    sFile = "D:\VPRT9000004726.xml"
    sUrl = "https://testapi.valenciaportpcs.net/messaging/messages/upload/default"
    sBoundary = "---------------------------166096475834725259111917034354"
    sAccessToken = "myaccesstoken"
    
    sResponse = pvPostFile(sUrl, sFile, sBoundary, sAccessToken)
    Debug.Print sResponse
End Sub

Private Function pvPostFile(sUrl As String, sFileName As String, sBoundary As String, sAccessToken As String) As String
    Dim xmlReq As MSXML2.ServerXMLHTTP60
    Dim nFile As Integer
    Dim baFile() As Byte
    Dim baHeader() As Byte
    Dim baFooter() As Byte
    Dim baBody() As Byte
    
    ' 直接读取XML文件原始字节，不做任何编码转换
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baFile(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baFile
    End If
    Close nFile
    
    ' 构造multipart头、尾部分的UTF-8字节
    Dim sHeader As String, sFooter As String
    sHeader = "--" & sBoundary & vbCrLf & _
        "Content-Disposition: form-data; name=""file""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
        "Content-Type: text/xml" & vbCrLf & vbCrLf
    sFooter = vbCrLf & "--" & sBoundary & "--"
    
    baHeader = StringToUTF8Bytes(sHeader)
    baFooter = StringToUTF8Bytes(sFooter)
    
    ' 拼接完整请求体字节
    baBody = MergeByteArrays(baHeader, baFile, baFooter)
    
    ' 发送请求
    Set xmlReq = New MSXML2.ServerXMLHTTP60
    With xmlReq
        .Open "POST", sUrl, False
        .setRequestHeader "Authorization", "Bearer " & sAccessToken
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & sBoundary
        .send baBody
        pvPostFile = .ResponseText
        ' 如需获取HTTP状态码可直接调用 .Status 属性
    End With
    Set xmlReq = Nothing
End Function

' 字符串转UTF-8字节数组，不受系统区域设置影响
Private Function StringToUTF8Bytes(sText As String) As Byte()
    Dim stm As ADODB.Stream
    Set stm = New ADODB.Stream
    With stm
        .Charset = "UTF-8"
        .Mode = adModeReadWrite
        .Type = adTypeText
        .Open
        .WriteText sText
        .Position = 0
        .Type = adTypeBinary
        StringToUTF8Bytes = .Read
    End With
    stm.Close
    Set stm = Nothing
End Function

' 合并多个字节数组
Private Function MergeByteArrays(ParamArray Arrays() As Variant) As Byte()
    Dim stm As ADODB.Stream
    Dim i As Long
    Set stm = New ADODB.Stream
    stm.Mode = adModeReadWrite
    stm.Type = adTypeBinary
    stm.Open
    For i = LBound(Arrays) To UBound(Arrays)
        stm.Write Arrays(i)
    Next i
    stm.Position = 0
    MergeByteArrays = stm.Read
    stm.Close
    Set stm = Nothing
End Function

代码中用到了ADODB.Stream做字节处理，需要先在VBA编辑器中添加引用：

• 点击顶部菜单「工具」-「引用」
• 勾选Microsoft ActiveX Data Objects x.x Library（选版本号最高的即可）
• 如果不想手动加引用，也可以把相关对象改成晚绑定方式，用CreateObject("ADODB.Stream")创建实例即可。

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