如何在VBA中发送带请求体的HTTP POST请求？转写问题解决

尝试用VBA发送POST请求，转写Python代码时遇到问题，运行后MsgBox显示空白。

Python实现代码：

import requests

headers = {
        "authority": "platform.example.com",
        "accept": "application/json, text/plain, */*",
        "user-agent": "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.141 Safari/537.36",
        "content-type": "application/json",
        "sec-fetch-site": "same-site",
        "sec-fetch-mode": "cors",
        "sec-fetch-dest": "empty",
        "accept-language": "en-US,en;q=0.9",
    }

data = "{\"messages\":[{\"to\":\"12345\",\"channel\":\"sms\",\"content\":\"Test message\"}]}"

r=requests.post("https://example.com/v1/message", headers=headers, data=data)

自行编写的VBA代码（无法正常工作）：

Sub test()
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Url = "https://example.com/v1/message"
objHTTP.Open "POST", Url, False
objHTTP.setRequestHeader "authority", "platform.example.com",
objHTTP.setRequestHeader "accept", "application/json, text/plain, */*"
objHTTP.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.141 Safari/537.36"
objHTTP.setRequestHeader "content-type", "application/json"
objHTTP.setRequestHeader "sec-fetch-site", "same-site"
objHTTP.setRequestHeader "sec-fetch-mode", "cors"
objHTTP.setRequestHeader "sec-fetch-dest", "empty"
objHTTP.setRequestHeader "accept-language", "en-US,en;q=0.9"

Data = """messages=[{'to':'1234','channel':'sms','content':'Test message'}]"""

objHTTP.send Data
MsgBox objHTTP.ResponseText
End Sub

你的VBA代码存在几个关键错误，修正后即可正常运行：

• 语法错误：objHTTP.setRequestHeader "authority", "platform.example.com", 这一行末尾多了逗号，会导致编译失败，直接删除末尾的逗号。
• JSON格式错误：
  • JSON规范要求键和字符串值必须用双引号，你用了单引号，服务端无法解析。
  • VBA中要在字符串里表示双引号，需要用两个双引号转义，不能直接用单引号。
  • 原Python的data是{"messages":[{"to":"12345","channel":"sms","content":"Test message"}]}，转成VBA字符串应该写成"{""messages"":[{""to"":""12345"",""channel"":""sms"",""content"":""Test message""}]}"。
• 冗余请求头：authority请求头通常由ServerXMLHTTP自动根据URL生成，可以移除；sec-fetch-*系列是浏览器自动添加的请求头，VBA请求中不需要，也可以移除（保留也不影响，但没必要）。

修正后的完整VBA代码 #

Sub test()
    Dim objHTTP As Object
    Dim Url As String
    Dim Data As String
    
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Url = "https://example.com/v1/message"
    
    objHTTP.Open "POST", Url, False
    objHTTP.setRequestHeader "accept", "application/json, text/plain, */*"
    objHTTP.setRequestHeader "user-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/87.0.4280.141 Safari/537.36"
    objHTTP.setRequestHeader "content-type", "application/json"
    objHTTP.setRequestHeader "accept-language", "en-US,en;q=0.9"
    
    ' 正确转义的JSON格式数据
    Data = "{""messages"":[{""to"":""12345"",""channel"":""sms"",""content"":""Test message""}]}"
    
    objHTTP.send Data
    
    ' 增加状态码显示，方便排查问题
    MsgBox "状态码: " & objHTTP.Status & vbCrLf & "响应内容: " & objHTTP.ResponseText
End Sub

额外排查建议 #

如果运行后还是没有响应，建议：

1. 检查objHTTP.Status的值，200系列表示请求成功，400/500系列表示服务端错误或请求参数有误。
2. 确认目标URL可以正常访问，没有被防火墙或代理拦截。
3. 对比Python请求的抓包数据，和VBA请求的头信息、请求体是否一致。

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