VBA POST方法中如何编码用户名密码并放入请求头调用API

存在的问题 #

• 请求头设置语法错误：setRequestHeader接收两个参数，第一个为请求头名称，第二个为对应值。你当前将Authorization: Basic作为头名传入，不符合规范，正确的头名应为Authorization，值为Basic 你的Base64编码串。
• 存在无效冗余代码：创建的WinHttp.WinHttpRequest.5.1对象HTTPReq全程未使用，可直接删除。
• JSON格式潜在风险：你使用Mid(body, 2, Len(body) - 2)裁剪序列化后的JSON串，若cJobject的serialize方法返回的是标准JSON，该操作会去掉外层大括号，导致请求体格式失效，仅在序列化结果确实存在多余外层字符时保留该逻辑。
• 编码有效性校验：请确认你的Base64编码串是由用户名:密码格式的字符串编码得到，若拼接规则错误也会触发认证失败。

修正后代码 #

Public Sub ConsultaFrete()
    Dim job As cJobject, jo As cJobject, cj As cJobject
    Dim body As String
    Dim xmlhttp As New MSXML2.XMLHTTP60
    Dim myurl As String
    
    myurl = "https://api.braspress.com/v1/cotacao/calcular/json"

    xmlhttp.Open "POST", myurl, False

    Set job = New cJobject
    body = ""

    ' 修正请求头设置格式
    xmlhttp.setRequestHeader "Authorization", "Basic MDU5MTAxNjIwMDAxODA6UG93ZGVybWl4MkAh"
    xmlhttp.setRequestHeader "Content-type", "application/json; charset=utf-8"

    With job.init(Nothing, "")
        .add "cnpjRemetente", "05910162000180"
        .add "cnpjDestinatario", "05198251000146"
        .add "modal", "R"
        .add "tipoFrete", "1"
        .add "cepOrigem", "11015201"
        .add "cepDestino", "48903500"
        .add "vlrMercadoria", "486.00"
        .add "peso", "14.00"
        .add "volumes", "2"
        With .add("cubagem").addArray.add
            .add "altura", "0.23"
            .add "largura", "0.44"
            .add "comprimento", "0.65"
            .add "volumes", "2"
        End With
    End With
       
    body = job.serialize
    ' 确认serialize返回结果是否需要裁剪，标准JSON不需要下面这行
    ' body = Mid(body, 2, Len(body) - 2)
    Debug.Print body
    
    xmlhttp.send body
    Debug.Print xmlhttp.responseText
End Sub

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