如何在VBA的GET/POST请求中传递Companies House API密钥？

You're running into an authentication issue because the way you're passing your API key doesn't match what Companies House expects. Let's break down the problem and fix your code:

What's Wrong With Your Current Code? #

Companies House requires Basic Authentication where:

• Your API key acts as the username
• The password field is left empty

To format this correctly for the Authorization header, you need to:

1. Combine your API key with a trailing colon (like your_api_key:) — the colon is mandatory even though the password is blank
2. Encode that combined string to Base64
3. Prefix the encoded string with Basic

Your current code skips the Base64 encoding and the mandatory colon, so the API rejects your request.

Step 1: Add a Base64 Encoding Function #

VBA doesn't have a built-in Base64 encoder, so we'll use MSXML to handle this reliably:

Function Base64Encode(ByVal inputString As String) As String
    Dim xmlDoc As Object
    Dim base64Node As Object
    
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    Set base64Node = xmlDoc.createElement("base64")
    
    base64Node.DataType = "bin.base64"
    base64Node.nodeTypedValue = StrConv(inputString, vbFromUnicode)
    
    Base64Encode = base64Node.Text
End Function

Step 2: Fix Your API Request Code #

Replace your existing code with this corrected version:

Sub GetCompaniesHouseData()
    Dim authKey As String
    Dim encodedAuth As String
    Dim strUrl As String
    Dim response As String
    
    ' Replace with your actual API key
    authKey = "your_api_key_here"
    ' Replace with your target API endpoint (e.g., https://api.company-information.service.gov.uk/company/00000000)
    strUrl = "your_api_endpoint_here"
    
    ' Encode the API key + colon for Basic Auth
    encodedAuth = Base64Encode(authKey & ":")
    
    ' Use MSXML2.ServerXMLHTTP instead of Microsoft.XMLHTTP (more reliable for API requests)
    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", strUrl, False
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "Authorization", "Basic " & encodedAuth
        .Send
        
        ' Add error handling to debug issues
        If .Status <> 200 Then
            MsgBox "Request failed. Status code: " & .Status & vbCrLf & "Message: " & .StatusText
            Exit Sub
        End If
        
        response = .ResponseText
    End With
    
    ' Output the response to the Immediate Window (Ctrl+G to view)
    Debug.Print response
End Sub

Key Notes: #

• Use MSXML2.ServerXMLHTTP.6.0: The older Microsoft.XMLHTTP has limitations for modern API requests — ServerXMLHTTP is more stable and supports more features.
• Mandatory Colon: Don't forget the colon after your API key when encoding — this tells the API you're using an empty password.
• Error Handling: Adding status code checks helps you debug issues like invalid endpoints or expired keys quickly.

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