如何将JSON格式API请求转为XML并通过VBA提交？

Hey Dan, let's break down your two requirements into actionable steps—converting JSON to a well-formed XML (even without a sample from the shipping site) and automating the submission with VBA.

一、First: Convert JSON to Valid XML (No Sample Needed) #

Since the shipping site didn't provide an XML example, we can follow standard mapping rules to generate a clean, compliant XML structure:

• Root Node: Start with a custom root (like <ShipmentRequest> or <Request>) to wrap the entire payload.
• Key-Value Pairs: Map JSON keys directly to XML tags, with values as the tag content (e.g., "id": "SH12345" becomes <id>SH12345</id>).
• Arrays: For JSON arrays, use the plural tag as the parent, then singular tags for each item (e.g., "packages": [...] becomes <packages><package>...</package></packages>).
• Nested Objects: Nest XML tags to match the JSON's hierarchical structure.

Example Conversion #

Suppose your curl's JSON looks like this:

{
  "shipment": {
    "id": "SH12345",
    "origin": "Shanghai",
    "destination": "Los Angeles",
    "packages": [
      {
        "weight": 10,
        "dimensions": {"length":50, "width":30, "height":20}
      }
    ]
  }
}

The converted XML would be:

<Request>
  <shipment>
    <id>SH12345</id>
    <origin>Shanghai</origin>
    <destination>Los Angeles</destination>
    <packages>
      <package>
        <weight>10</weight>
        <dimensions>
          <length>50</length>
          <width>30</width>
          <height>20</height>
        </dimensions>
      </package>
    </packages>
  </shipment>
</Request>

二、VBA Implementation: Convert JSON to XML + Submit to Gateway #

We'll split this into two parts: the JSON-to-XML converter, and the HTTP submission code.

Prerequisites #

First, enable these references in your VBA project (go to Tools > References):

• Microsoft Scripting Runtime
• Microsoft XML, v6.0
• We'll use the popular JsonConverter module for parsing JSON (it's far more reliable than built-in tools). You can import this module into your VBA project by copying its code directly into your project file.

1. JSON to XML Converter Function #

This recursive function handles all JSON structures (objects, arrays, values):

Option Explicit

Function JsonToXml(jsonText As String, Optional rootNodeName As String = "Request") As String
    Dim jsonObj As Object
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim rootNode As MSXML2.IXMLDOMElement
    
    ' Parse the JSON string into a VBA object
    Set jsonObj = JsonConverter.ParseJson(jsonText)
    
    ' Initialize XML document
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Indent = True ' Pretty-print the XML
    Set rootNode = xmlDoc.createElement(rootNodeName)
    xmlDoc.appendChild rootNode
    
    ' Recursively map JSON to XML
    ProcessJsonNode jsonObj, rootNode, xmlDoc
    
    JsonToXml = xmlDoc.XML
End Function

Private Sub ProcessJsonNode(jsonNode As Variant, parentXmlNode As MSXML2.IXMLDOMElement, xmlDoc As MSXML2.DOMDocument60)
    Dim key As Variant
    Dim item As Variant
    Dim childNode As MSXML2.IXMLDOMElement
    
    Select Case TypeName(jsonNode)
        Case "Dictionary" ' JSON object (key-value pairs)
            For Each key In jsonNode.Keys
                Set childNode = xmlDoc.createElement(key)
                parentXmlNode.appendChild childNode
                ProcessJsonNode jsonNode(key), childNode, xmlDoc
            Next key
        Case "Collection" ' JSON array
            For Each item In jsonNode
                ' Use singular version of parent tag for array items (adjust if needed)
                Dim itemTag As String
                itemTag = Left(parentXmlNode.nodeName, Len(parentXmlNode.nodeName) - 1)
                Set childNode = xmlDoc.createElement(itemTag)
                parentXmlNode.appendChild childNode
                ProcessJsonNode item, childNode, xmlDoc
            Next item
        Case Else ' Plain value (string, number, boolean)
            parentXmlNode.Text = CStr(jsonNode)
    End Select
End Sub

2. VBA Code to Submit XML to the Gateway #

This replicates your curl POST request, including headers and payload:

Sub SubmitXmlToGateway(xmlText As String, apiUrl As String)
    Dim xmlHttp As MSXML2.XMLHTTP60
    Set xmlHttp = New MSXML2.XMLHTTP60
    
    On Error GoTo RequestError
    
    ' Open POST request to the gateway
    xmlHttp.Open "POST", apiUrl, False
    
    ' Add request headers (match exactly what's in your curl command!)
    xmlHttp.setRequestHeader "Content-Type", "application/xml"
    ' If your curl has auth headers (e.g., Authorization: Bearer XXX), add them here:
    ' xmlHttp.setRequestHeader "Authorization", "Bearer YOUR_AUTH_TOKEN"
    
    ' Send the XML payload
    xmlHttp.send xmlText
    
    ' Handle response
    If xmlHttp.Status = 200 Then
        MsgBox "Submission successful! Response:" & vbCrLf & xmlHttp.responseText
    Else
        MsgBox "Submission failed. Status code: " & xmlHttp.Status & vbCrLf & "Response:" & vbCrLf & xmlHttp.responseText
    End If
    
    Exit Sub
    
RequestError:
    MsgBox "Error during request: " & Err.Description
End Sub

3. Full End-to-End Example #

Put it all together to convert your curl JSON and submit it:

Sub FullShippingRequestProcess()
    ' Paste your JSON from the curl command here
    Dim jsonPayload As String
    jsonPayload = "{""shipment"": {""id"": ""SH12345"", ""origin"": ""Shanghai"", ""destination"": ""Los Angeles"", ""packages"": [{""weight"":10, ""dimensions"": {""length"":50, ""width"":30, ""height"":20}}]}}"
    
    ' Convert JSON to XML
    Dim xmlPayload As String
    xmlPayload = JsonToXml(jsonPayload)
    
    ' Replace with your actual shipping gateway URL
    Dim gatewayUrl As String
    gatewayUrl = "https://your-shipping-gateway.com/api/submit"
    
    ' Submit the XML
    SubmitXmlToGateway xmlPayload, gatewayUrl
End Sub

三、Key Notes to Avoid Issues #

• Match Curl Headers Exactly: Don't skip any headers from your original curl command (like User-Agent, Authorization, etc.—these are often required for the gateway to accept your request).
• XML Tag Validation: If your JSON has keys that don't follow XML rules (e.g., start with a number, contain special characters), modify the ProcessJsonNode function to clean up tag names.
• No Third-Party Module? If you can't use JsonConverter, replace the parsing step with a ScriptControl (note: this may be blocked by security policies in some environments):

  Function ParseJsonWithScriptControl(jsonText As String) As Object
      Dim sc As Object
      Set sc = CreateObject("ScriptControl")
      sc.Language = "JScript"
      Set ParseJsonWithScriptControl = sc.Eval("(" & jsonText & ")")
  End Function
  

  Then swap JsonConverter.ParseJson(jsonText) with ParseJsonWithScriptControl(jsonText) in the JsonToXml function.

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