Excel VBA实现JSON POST请求遇401授权错误，求签名生成及配置方法

首先，先帮你修正原VBA代码里的两个明显小问题，这可能是导致错误的一部分原因：

• 你把Content-Type头写成了RequestName，这会导致服务器无法识别请求体的格式
• 请求URL里的域名是qa.towertech.com，但Host头是qa.etowertech.com，两者要保持一致

接下来，核心问题是你还没有正确生成并配置授权签名——这正是401错误提示“Authorization information is invalid”的原因。根据你给出的签名规则，我来帮你实现完整的VBA代码，包括签名生成逻辑：

第一步：理解签名生成规则 #

要生成有效的Authorization头，你需要：

1. 构造签名字符串：POST + 换行符（vbLf，对应\0x000A） + X-WallTech-Date的取值 + 换行符 + 完整请求URL
2. 使用你的Access Secret（注意：这是和你提供的Access Token配对的密钥，不是Token本身）对这个字符串做HMAC SHA-1加密
3. 将加密后的二进制结果做Base64编码
4. 最后组成Authorization头：WallTech <你的Access Token>:<Base64编码后的签名>

第二步：完整VBA代码实现 #

首先，确保你的VBA项目引用了Microsoft XML, v6.0和Microsoft Scripting Runtime（在VBA编辑器的“工具”→“引用”里勾选）。然后使用以下代码：

Sub SendJsonPostRequest()
    Dim JsonHTTP As MSXML2.XMLHTTP60
    Dim body As String
    Dim accessToken As String
    Dim accessSecret As String
    Dim requestUrl As String
    Dim wallTechDate As String
    Dim signatureString As String
    Dim hmacSignature As String
    Dim authorizationHeader As String
    
    ' 替换为你的实际信息
    accessToken = "test5AdbzO5OEeOpvgAVXUFE0A"
    accessSecret = "你的Access Secret密钥" ' 这里是和Token配对的密钥，你需要自己获取
    requestUrl = "http://qa.etowertech.com/services/shipper/orders"
    body = "你的JSON请求体内容" ' 比如 ""{""key"":""value""}""
    
    ' 生成符合格式的X-WallTech-Date（GMT时区）
    wallTechDate = Format$(UTCNow(), "ddd, dd MMM yyyy HH:mm:ss") & " GMT"
    
    ' 构造签名字符串
    signatureString = "POST" & vbLf & wallTechDate & vbLf & requestUrl
    
    ' 生成HMAC SHA-1签名并Base64编码
    hmacSignature = Base64Encode(HMACSHA1(signatureString, accessSecret))
    
    ' 构造Authorization头
    authorizationHeader = "WallTech " & accessToken & ":" & hmacSignature
    
    ' 发送请求
    Set JsonHTTP = New MSXML2.XMLHTTP60
    With JsonHTTP
        .Open "POST", requestUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Accept", "application/json"
        .setRequestHeader "User-Agent", "Mozilla 5.0"
        .setRequestHeader "Host", "qa.etowertech.com"
        .setRequestHeader "X-WallTech-Date", wallTechDate
        .setRequestHeader "Authorization", authorizationHeader
        .send body
    End With
    
    ' 输出响应结果
    Debug.Print JsonHTTP.responseText
    
    Set JsonHTTP = Nothing
End Sub

' 获取当前UTC时间（用于生成X-WallTech-Date）
Function UTCNow() As Date
    UTCNow = DateAdd("h", -TimeZoneOffset(Now()), Now())
End Function

' 获取当前时区与UTC的偏移小时数
Function TimeZoneOffset(dt As Date) As Integer
    Dim tzi As Object
    Set tzi = CreateObject("WScript.Shell").RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
    TimeZoneOffset = tzi / 60
End Function

' 生成HMAC SHA-1哈希
Function HMACSHA1(ByVal message As String, ByVal secret As String) As Byte()
    Dim enc As Object
    Dim bytesMessage() As Byte
    Dim bytesSecret() As Byte
    Dim hmac As Object
    
    Set enc = CreateObject("System.Text.UTF8Encoding")
    bytesMessage = enc.GetBytes_4(message)
    bytesSecret = enc.GetBytes_4(secret)
    
    Set hmac = CreateObject("System.Security.Cryptography.HMACSHA1")
    hmac.Key = bytesSecret
    
    HMACSHA1 = hmac.ComputeHash_2(bytesMessage)
End Function

' 将二进制数据Base64编码
Function Base64Encode(ByVal bytes() As Byte) As String
    Dim xmlDoc As Object
    Dim node As Object
    
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Set node = xmlDoc.createElement("b64")
    node.dataType = "bin.base64"
    node.nodeTypedValue = bytes
    
    Base64Encode = node.Text
End Function

第三步：代码说明 #

1. 时间处理：UTCNow函数生成GMT时间，确保X-WallTech-Date符合要求的格式
2. 签名生成：HMACSHA1函数使用.NET的加密对象生成HMAC SHA-1哈希，Base64Encode将哈希结果转成Base64字符串
3. 请求头修正：修正了Content-Type头，确保URL和Host头一致，并且动态生成了符合要求的Authorization头

注意事项 #

• 一定要替换accessSecret为你实际的Access Secret密钥（这是服务器用来验证签名的关键，只有你自己知道）
• 确保body是合法的JSON格式字符串
• 如果运行时提示对象创建错误，检查是否启用了宏，以及是否正确引用了所需的库

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