VBA使用MSXML2.XMLHTTP60发起POST请求如何传递headers等多类参数

MSXML2.XMLHTTP60没有内置的字典传参封装，我们可以通过自行封装工具函数实现类似效果，以下分场景给出实现代码：

场景1：仅传表单数据（无文件上传） #

对应Python写法中仅传data参数的场景，默认Content-Type为application/x-www-form-urlencoded

前置依赖 #

需要使用Scripting.Dictionary存储参数，可通过两种方式启用：

• 提前引用：VBE界面→工具→引用，勾选「Microsoft Scripting Runtime」
• 晚绑定：代码中用CreateObject("Scripting.Dictionary")创建字典实例

封装及调用代码 #

' 字典转表单格式字符串工具函数
Function DictToFormData(params As Object) As String
    Dim key As Variant, formParts As Collection
    Set formParts = New Collection
    
    For Each key In params.Keys
        formParts.Add URLEncode(CStr(key)) & "=" & URLEncode(CStr(params(key)))
    Next
    
    DictToFormData = JoinCollection(formParts, "&")
End Function

' URL编码工具函数（处理特殊字符）
Function URLEncode(str As String) As String
    Dim i As Integer, charCode As Integer
    URLEncode = ""
    For i = 1 To Len(str)
        charCode = Asc(Mid(str, i, 1))
        Select Case charCode
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
                URLEncode = URLEncode & Mid(str, i, 1)
            Case 32
                URLEncode = URLEncode & "+"
            Case Else
                URLEncode = URLEncode & "%" & Hex(charCode)
        End Select
    Next
End Function

' 集合转字符串工具函数
Function JoinCollection(col As Collection, delimiter As String) As String
    Dim i As Integer
    If col.Count = 0 Then Exit Function
    JoinCollection = col(1)
    For i = 2 To col.Count
        JoinCollection = JoinCollection & delimiter & col(i)
    Next
End Function

' 调用示例
Sub PostFormData()
    Dim req As Object, data As Object, reqURL As String
    Set req = CreateObject("MSXML2.XMLHTTP.6.0")
    Set data = CreateObject("Scripting.Dictionary")
    reqURL = "你的请求地址"
    
    ' 按字典形式传参数，和Python写法逻辑一致
    data.Add "key1", "value1"
    data.Add "key2", "value2"
    
    With req
        .Open "POST", reqURL, False
        .setRequestHeader "Accept", "Application/json"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        ' 直接传入转换后的表单数据
        .send DictToFormData(data)
        ' 输出返回结果
        Debug.Print .responseText
    End With
End Sub

场景2：同时传表单数据+文件上传 #

对应Python写法中同时传data和files的场景，需要构造multipart/form-data格式的请求体：

Sub PostWithFile()
    Dim req As Object, data As Object, files As Object
    Dim reqURL As String, boundary As String, body() As Byte
    Dim stream As Object
    
    Set req = CreateObject("MSXML2.XMLHTTP.6.0")
    Set data = CreateObject("Scripting.Dictionary")
    Set files = CreateObject("Scripting.Dictionary")
    Set stream = CreateObject("ADODB.Stream")
    reqURL = "你的请求地址"
    boundary = "----WebKitFormBoundary" & VBA.Replace(VBA.Replace(VBA.Now, ":", ""), "/", "") ' 随机边界值
    
    ' 字典形式传普通表单参数
    data.Add "key1", "value1"
    data.Add "key2", "value2"
    ' 字典形式传文件参数
    files.Add "upload_file", "C:\路径\myfile.csv"
    
    ' 构造multipart请求体
    stream.Type = 1 ' 二进制模式
    stream.Open
    Call WriteStringToStream(stream, "--" & boundary & vbCrLf)
    
    ' 写入普通表单字段
    Dim key As Variant
    For Each key In data.Keys
        Call WriteStringToStream(stream, "Content-Disposition: form-data; name=""" & key & """" & vbCrLf & vbCrLf)
        Call WriteStringToStream(stream, data(key) & vbCrLf)
        Call WriteStringToStream(stream, "--" & boundary & vbCrLf)
    Next
    
    ' 写入文件字段
    For Each key In files.Keys
        Dim filePath As String, fileName As String
        filePath = files(key)
        fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
        Call WriteStringToStream(stream, "Content-Disposition: form-data; name=""" & key & """; filename=""" & fileName & """" & vbCrLf)
        Call WriteStringToStream(stream, "Content-Type: text/csv" & vbCrLf & vbCrLf) ' 根据文件类型调整Content-Type
        ' 读取文件二进制内容写入流
        Dim fileStream As Object
        Set fileStream = CreateObject("ADODB.Stream")
        fileStream.Type = 1
        fileStream.Open
        fileStream.LoadFromFile filePath
        stream.Write fileStream.Read
        fileStream.Close
        Call WriteStringToStream(stream, vbCrLf & "--" & boundary & "--" & vbCrLf)
    Next
    
    stream.Position = 0
    body = stream.Read
    stream.Close
    
    With req
        .Open "POST", reqURL, False
        .setRequestHeader "Accept", "Application/json"
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
        .send body
        Debug.Print .responseText
    End With
End Sub

' 辅助函数：字符串写入二进制流
Sub WriteStringToStream(stream As Object, str As String)
    Dim adodbStream As Object
    Set adodbStream = CreateObject("ADODB.Stream")
    adodbStream.Charset = "utf-8"
    adodbStream.Type = 2 ' 文本模式
    adodbStream.Open
    adodbStream.WriteText str
    adodbStream.Position = 0
    adodbStream.Type = 1 ' 转二进制
    stream.Write adodbStream.Read
    adodbStream.Close
End Sub

额外场景：发送JSON格式请求体 #

如果接口要求传JSON格式的参数，直接把字典转为JSON字符串发送即可，可引入VBA-JSON库实现字典转JSON，示例如下：

Sub PostJson()
    Dim req As Object, data As Object, reqURL As String
    Set req = CreateObject("MSXML2.XMLHTTP.6.0")
    Set data = CreateObject("Scripting.Dictionary")
    reqURL = "你的请求地址"
    
    data.Add "key1", "value1"
    data.Add "key2", "value2"
    
    With req
        .Open "POST", reqURL, False
        .setRequestHeader "Accept", "Application/json"
        .setRequestHeader "Content-Type", "application/json"
        ' JsonConverter.ConvertToJson为VBA-JSON库提供的方法
        .send JsonConverter.ConvertToJson(data)
        Debug.Print .responseText
    End With
End Sub

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