调用英国公司信息API获取基础企业信息时出现Empty Authorization header错误的VBA代码求助

Let's break down what's going wrong here and fix your code step by step.

Why You're Getting the Error #

The UK Company Information Service API requires Basic Authentication for all requests, but your current code is sending a custom api_key header that the API doesn't recognize. That's why it's throwing the "Empty Authorization header" error—you're not providing authentication in the format it expects.

Additionally, your request parameter has unnecessary curly braces around the company number, which will cause the search to fail even once auth is fixed.

Corrected VBA Code #

First, we'll add a helper function to handle Base64 encoding (required for Basic Auth), then fix the request setup:

' Helper function to encode string to Base64
Function Base64Encode(ByVal inputStr As String) As String
    Dim xmlDoc As Object, xmlNode As Object
    Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
    Set xmlNode = xmlDoc.createElement("b64")
    xmlNode.DataType = "bin.base64"
    xmlNode.nodeTypedValue = StrConv(inputStr, vbFromUnicode)
    Base64Encode = xmlNode.Text
End Function

Sub read_from_api()
    Dim url As String, parameters As String
    Dim apiKey As String
    Dim authString As String, encodedAuth As String
    
    ' API Configuration
    url = "https://api.company-information.service.gov.uk/company/"
    apiKey = "10d54202-df9c-4e72-8753-f11bh5c7c427" ' Replace with your actual API key
    parameters = "?q=00519500" ' Removed unnecessary curly braces
    
    ' Prepare Basic Authentication
    ' For this API, use your API key as the username, leave password empty
    authString = apiKey & ":" & ""
    encodedAuth = Base64Encode(authString)
    
    ' Send Request
    Dim request As New WinHttpRequest
    request.Open "GET", url & parameters
    ' Set the standard Authorization header
    request.SetRequestHeader "Authorization", "Basic " & encodedAuth
    request.Send
    
    ' Handle Response
    If request.Status <> 200 Then
        MsgBox "Error " & request.Status & ": " & request.ResponseText
        Exit Sub
    End If
    
    ' Parse JSON response (requires JsonConverter module)
    Dim response As Object
    Set response = JsonConverter.ParseJson(request.ResponseText)
    
    ' Example: Print company name to Immediate Window
    Debug.Print "Company Name: " & response("items")(1)("title")
End Sub

Key Changes Explained #

• Authentication Fix: We replaced the custom api_key header with the standard Authorization header using Basic Auth. The API key is used as the username (with an empty password), encoded to Base64 as required by the Basic Auth standard.
• Parameter Fix: Removed the curly braces around the company number in parameters—the API expects the raw value for the q query parameter.
• Error Handling: Added the status code to the error message for better debugging.
• Example Parsing: Added a line to print a company name from the response (adjust based on the data you need).

Notes #

• Make sure you have the JsonConverter module installed (you mentioned using it in your original code) to parse the JSON response.
• Double-check your API key to ensure it's valid—typos here will also cause authentication failures.

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