Excel VBA API Query - Credentials not found

Get Help
, ,
1

I know this is more of an Excel related question than a GF one, but I thought I’d check here because I can’t find an answer anywhere else.

I’m trying to GET request the GF API on our site using a VBA macro in Excel. I’ve checked the query on Postman and it works fine with the credentials I’m using, but for some reason when I run the macro in Excel I get “Response: {“code”:“rest_forbidden”,“message”:“Sorry, you are not allowed to do that.”,“data”:{“status”:401}} Error: Sorry, you are not allowed to do that.” as the response.

In the log it says “…ERROR → GF_REST_Authentication::perform_basic_authentication(): Aborting; credentials not found.”

Am I missing something in the way I’m generating the request in VBA? Here’s the current code:

Option Explicit
   
Sub RetrieveEntriesFromGravityForms()
    Dim httpRequest As Object
    Dim responseText As String
    Dim apiUrl As String
    Dim formId As String
    Dim fromDate As String
    Dim toDate As String

    Dim username As String
    Dim password As String

    username = "Consumer_Key"
    password = "Consumer_Secret"

    formId = "#"

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long

    Set wb = Workbooks.Open("WorkbookName.xslm")
    Set ws = wb.Sheets("Sheet Name")

    ' ...other code for getting the fromDate etc...

    ' Build the API URL for retrieving entries within the specified date range

    apiUrl = https://ourorg.org/wp-json/gf/v2/forms/ & formId & "/entries?search={""start_date"":""" & fromDate & """}&_field_ids=65,80,33,34,72,45,46,2,3,41,35,4,5.1,5.3,5.4,5.5,43,77,42,6,51,8,9,39.1,11,12,32,15,16,25,26,27,48,64,40,49,23,24,21,83,67,61,66"
    
    Set httpRequest = CreateObject("MSXML2.XMLHTTP")
  
    Dim encodeKey As String
    encodeKey = Base64Encode(username & ":" & password)

    With httpRequest
        .Open "GET", apiUrl, False
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json"
        .SetRequestHeader "Authorization", "Basic " & encodeKey
        .send
    End With
 
    responseText = httpRequest.responseText

    Debug.Print "Response: " & responseText

    ' Parse the JSON response to extract the entries

    Dim parsedResponse As Object

    Set parsedResponse = JsonConverter.ParseJson(responseText)

    ' Check if there was an error in the response

    If parsedResponse("code") = "rest_forbidden" Then

        Dim errorMessage As String

        errorMessage = parsedResponse("message")

        Debug.Print "Error: " & errorMessage

        Exit Sub

    End If
 
' ...more code for parsing the JSON response...

End Sub


Function Base64Encode(ByVal sText As String) As String

    Dim bytesToEncode() As Byte

    bytesToEncode = StrConv(sText, vbFromUnicode)
 
    Dim objXML As Object

    Set objXML = CreateObject("MSXML2.DOMDocument")

    Dim objNode As Object

    Set objNode = objXML.createElement("b64")

    objNode.DataType = "bin.base64"

    objNode.nodeTypedValue = bytesToEncode

    Base64Encode = objNode.Text

    Set objNode = Nothing

    Set objXML = Nothing

End Function

Many thanks!

2

This topic was automatically closed 30 days after the last reply. New replies are no longer allowed.