Excel VBA将表格数据转JSON后POST到API无响应问题求助

• Content-Type配置错误：你当前提交的是JSON格式数据，但请求头设置的是application/x-www-form-urlencoded（表单提交格式），绝大多数接收JSON的接口都会因为格式不匹配直接拒绝请求，需要修改为application/json。
• 缺少错误状态判断：当前代码仅读取响应文本，没有校验HTTP状态码，接口返回4xx参数错误、5xx服务错误时，响应文本大概率为空，建议增加状态码、状态文本的打印逻辑定位具体错误。
• 手动拼接JSON存在转义风险：如果单元格内容包含双引号、换行符、斜杠等特殊字符，手动拼接的JSON会存在语法错误，接口识别到非法JSON会直接丢弃请求，建议对单元格内容做转义处理，或使用VBA JSON序列化库生成标准JSON。
• 鉴权/SSL配置缺失：如果接口需要身份验证（如Token、API密钥），需要补充对应请求头；如果请求的是HTTPS接口且存在证书校验问题，需要补充SSL忽略配置。
• 先验证接口可用性：将代码生成的JSON字符串复制到接口测试工具中发起请求，确认接口本身可正常调用、JSON格式符合要求，排除接口侧的问题。

Option Explicit

Sub ConvertAndSend()
    Dim apiJSON As String
    apiJSON = ConvertJSON
    ' 调试用：打印生成的JSON，确认格式正确
    Debug.Print apiJSON
    
    Dim apiResponse As String
    apiResponse = httpPost("替换为实际API地址", apiJSON)
    ' 调试用：打印响应结果
    Debug.Print apiResponse
End Sub

Function ConvertJSON() As String
    Dim wkb As Workbook
    Dim wks As Worksheet
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets(1)
            
    Dim lcolumn As Long
    lcolumn = wks.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim lrow As Long
    lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    
    Dim titles() As String
    ReDim titles(lcolumn)
    Dim i As Long
    For i = 1 To lcolumn
        titles(i) = wks.Cells(1, i)
    Next i
    
    Dim json As String
    json = "["
    
    Dim dq As String
    dq = """"
    
    Dim j As Long
    For j = 2 To lrow
        For i = 1 To lcolumn
            If i = 1 Then
                json = json & "{"
            End If
            
            Dim cellvalue As Variant
            cellvalue = wks.Cells(j, i)
            ' 转义单元格内容里的双引号，避免JSON格式错误
            cellvalue = Replace(cellvalue, """", "\""")
            json = json & dq & titles(i) & dq & ":" & dq & cellvalue & dq
            If i <> lcolumn Then
                json = json & ","
            End If
        Next i
        json = json & "}"
        If j <> lrow Then
            json = json & ","
        End If
    Next j
    ConvertJSON = json & "]"
End Function

Function httpPost(url As String, msg As String) As String
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        ' 忽略SSL证书错误，HTTPS接口需要开启
        .Option(4) = 13056
        .Open "POST", url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        ' 修改为JSON格式的Content-Type
        .setRequestHeader "Content-type", "application/json;charset=UTF-8"
        ' 如有API密钥、鉴权Token，在此处补充请求头
        '.setRequestHeader "Authorization", "Bearer 你的Token"
        .send msg
        ' 调试用：打印HTTP状态码和状态描述
        Debug.Print "HTTP状态码：" & .Status, "状态描述：" & .StatusText
        httpPost = .responseText
    End With
End Function

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