使用VBA通过POST发送JSON至API返回空值问题求助

你的代码存在几个关键问题，导致API无法正确解析JSON数据，返回空数组，以下是具体修复方案：

1. JSON字符串构造错误 #

你拼接JSON的方式导致邮箱字段被包裹了双重双引号，属于无效JSON格式，API解析失败后返回空数组。

错误写法：

Json = "{""name"": ""Fulano"", ""email"":" + """""" + oExchUser.PrimarySmtpAddress + """""" + "}"

正确写法（遵循VBA双引号转义规则，两个双引号代表一个双引号）：

Json = "{""name"": ""Fulano"", ""email"": """ & oExchUser.PrimarySmtpAddress & """}"

2. 未设置Content-Type请求头 #

发送JSON数据时，必须告知API请求体格式为application/json，否则API可能无法识别数据格式，导致解析失败。

在objHTTP.Open之后、objHTTP.Send之前添加：

objHTTP.SetRequestHeader "Content-Type", "application/json"

3. 异步请求的潜在问题 #

代码中使用了异步请求（Open方法第三个参数为True），若未处理异步回调，可能导致请求未完成就结束进程。建议改为同步请求（参数设为False），确保请求完整发送并可获取响应。

修改为：

objHTTP.Open "POST", Url, False

4. 添加响应排查代码 #

可以添加代码打印API的响应内容，帮助确认请求是否成功、数据是否被正确接收：

objHTTP.Send Json
' 打印响应信息到调试窗口
Debug.Print "状态码：" & objHTTP.Status
Debug.Print "响应内容：" & objHTTP.ResponseText

完整修正后的代码 #

Sub Show()
    Dim OL As Object, olAllUsers As Object, oExchUser As Object, oentry As Object
    Dim User As String
    Dim Json As String
    Dim objHTTP As Object
    
    Set OL = CreateObject("outlook.application")
    Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
    User = OL.Session.CurrentUser.Name
    Set oentry = olAllUsers.Item(User)
    Set oExchUser = oentry.GetExchangeUser()
    
    ' 正确构造JSON字符串
    Json = "{""name"": ""Fulano"", ""email"": """ & oExchUser.PrimarySmtpAddress & """}"
    
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    Url = "http://example"
    objHTTP.Open "POST", Url, False
    ' 设置Content-Type请求头
    objHTTP.SetRequestHeader "Content-Type", "application/json"
    objHTTP.Send Json
    
    ' 打印响应信息用于排查
    Debug.Print "状态码：" & objHTTP.Status
    Debug.Print "响应内容：" & objHTTP.ResponseText
    
    ' 释放对象
    Set objHTTP = Nothing
    Set oExchUser = Nothing
    Set oentry = Nothing
    Set olAllUsers = Nothing
    Set OL = Nothing
End Sub

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