0

Currently running a script to access a web API, and I'm able to see the data in the Immediate window as well as save the responsetext as a notepad dump file, but I'm struggling with how to then store the records into an organised format in Microsoft Access.

I've imported the JSONConverter but haven't had much luck.

(I tried tagging VBA in this question but when I did I wasn't able to post despite also tagging MS-Access)

Running the below saves the notepad file with no issue.

Public Sub APIPULLTEST()
    Dim sUrl As String, sAuth As String, XMLHttpReq As MSXML2.ServerXMLHTTP60
    sUrl = "Webpage XXXX"
    SUsername = "XXXXX"
    SPassword = "XXXXXXXXXXXXXXXXXXXXX"
    sAuth = TextBase64Encode(SUsername & ":" & SPassword, "us-ascii")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sUrl, False
        .setRequestHeader "Authorization", sAuth
        .send
        WriteTextFile .responseText, "E:\TEST\info.txt"
    End With
End Sub

Public Sub WriteTextFile(ByVal htmlResponse As String, ByVal fileName As String)
    Dim fso As Object, f As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateTextFile(fileName, True, True)
    f.Write htmlResponse
    f.Close
End Sub


But when I try to expand on the above and include JSONConverter lines, I get errors once I reach the Set data = jsonResponse("""Data""") line:

Sub PullAPIData()

    On Error GoTo ErrorHandler
    
    Dim apiURL As String
    Dim httpRequest As Object
    Dim jsonResponse As Object
    Dim username As String
    Dim apiKey As String

    ' Set URL
    apiURL = "Webpage XXXX"

    ' Set username and API key
    username = "XXXXX"
    apiKey = "XXXXXXXXXXXXX"

    
    Set httpRequest = CreateObject("MSXML2.XMLHTTP")

    
    httpRequest.Open "GET", apiURL, False
    httpRequest.setRequestHeader "Content-Type", "application/json"
    httpRequest.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & apiKey)
    httpRequest.send

    ' 200 Check
    If httpRequest.Status = 200 Then

        
        Dim filePath As String
        filePath = "E:\TEST\info.txt"
        SaveJsonResponseToFile httpRequest.responseText, filePath

        ' Parse the JSON response using VBA-JSON library
        Set jsonResponse = JsonConverter.ParseJson(httpRequest.responseText)

        ' Check if the JSON response is not empty
        If Not jsonResponse Is Nothing Then
            ' Check if "data" exists in the JSON response
            If jsonResponse.Exists("""data""") Then
                Dim data As Object
                Set data = jsonResponse("""data""")

                ' Check if "updated" exists within "data"
                If data.Exists("""updated""") Then
                    Dim updated As String
                    updated = data("""updated""")
                    Debug.Print "Updated: " & updated
                Else
                    Debug.Print "Updated field not found"
                End If

                ' Check if "created" exists within "data"
                If data.Exists("""created""") Then
                    Dim created As String
                    created = data("""created""")
                    Debug.Print "Created: " & created
                Else
                    Debug.Print "Created field not found"
                End If

            Else
                Debug.Print "Data field not found"
            End If
        Else
            MsgBox "No data found in the JSON response.", vbExclamation
        End If
    End If

    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical

End Sub

I'm pretty new to this, so I'm sure my script above is probably over-worked.

Brian Tompsett - 汤莱恩
  • 5,753
  • 72
  • 57
  • 129
DeepFriar
  • 13
  • 3

0 Answers0