GoldApiExample.bas

Attribute VB_Name = "GoldApiExample"
Option Explicit

Public Sub FetchGoldPrice()
    Const GoldApiToken As String = "your_goldapi_token_here"
    Const Metal As String = "XAU"
    Const CurrencyCode As String = "USD"

    If GoldApiToken = "your_goldapi_token_here" Or Len(GoldApiToken) = 0 Then
        MsgBox "Set your GoldAPI.io token before running FetchGoldPrice.", vbExclamation
        Exit Sub
    End If

    Dim endpoint As String
    endpoint = "https://www.goldapi.io/api/" & EncodePathSegment(Metal) & "/" & EncodePathSegment(CurrencyCode)

    Dim request As Object
    Set request = CreateObject("WinHttp.WinHttpRequest.5.1")

    request.Open "GET", endpoint, False
    request.SetRequestHeader "x-access-token", GoldApiToken
    request.SetRequestHeader "Accept", "application/json"
    request.Send

    If request.Status < 200 Or request.Status >= 300 Then
        MsgBox "GoldAPI.io request failed (" & request.Status & "): " & request.ResponseText, vbCritical
        Exit Sub
    End If

    WriteResponseToWorksheet request.ResponseText
End Sub

Private Sub WriteResponseToWorksheet(ByVal responseText As String)
    Dim worksheet As Worksheet
    Set worksheet = GetOrCreateWorksheet("GoldAPI")

    worksheet.Cells.Clear
    worksheet.Range("A1").Value = "Field"
    worksheet.Range("B1").Value = "Value"
    worksheet.Range("A1:B1").Font.Bold = True

    WriteSummaryRow worksheet, 2, "Metal", GetJsonValue(responseText, "metal")
    WriteSummaryRow worksheet, 3, "Currency", GetJsonValue(responseText, "currency")
    WriteSummaryRow worksheet, 4, "Price", GetJsonValue(responseText, "price")
    WriteSummaryRow worksheet, 5, "Bid", GetJsonValue(responseText, "bid")
    WriteSummaryRow worksheet, 6, "Ask", GetJsonValue(responseText, "ask")
    WriteSummaryRow worksheet, 7, "Change", GetJsonValue(responseText, "ch")
    WriteSummaryRow worksheet, 8, "Change Percent", GetJsonValue(responseText, "chp") & "%"
    WriteSummaryRow worksheet, 9, "Exchange", GetJsonValue(responseText, "exchange")
    WriteSummaryRow worksheet, 10, "Symbol", GetJsonValue(responseText, "symbol")
    WriteSummaryRow worksheet, 11, "Timestamp", GetJsonValue(responseText, "timestamp")

    worksheet.Range("D1").Value = "Full response"
    worksheet.Range("D1").Font.Bold = True
    worksheet.Range("D2").Value = responseText
    worksheet.Range("D2").WrapText = True
    worksheet.Columns("A:B").AutoFit
    worksheet.Columns("D").ColumnWidth = 120
End Sub

Private Sub WriteSummaryRow(ByVal worksheet As Worksheet, ByVal rowIndex As Long, ByVal fieldName As String, ByVal fieldValue As String)
    worksheet.Cells(rowIndex, 1).Value = fieldName
    worksheet.Cells(rowIndex, 2).Value = fieldValue
End Sub

Private Function GetOrCreateWorksheet(ByVal name As String) As Worksheet
    On Error Resume Next
    Set GetOrCreateWorksheet = ThisWorkbook.Worksheets(name)
    On Error GoTo 0

    If GetOrCreateWorksheet Is Nothing Then
        Set GetOrCreateWorksheet = ThisWorkbook.Worksheets.Add
        GetOrCreateWorksheet.Name = name
    End If
End Function

Private Function EncodePathSegment(ByVal value As String) As String
    EncodePathSegment = Replace(value, " ", "%20")
End Function

Private Function GetJsonValue(ByVal jsonText As String, ByVal key As String) As String
    Dim marker As String
    marker = """" & key & """:"

    Dim startIndex As Long
    startIndex = InStr(1, jsonText, marker, vbTextCompare)
    If startIndex = 0 Then
        GetJsonValue = ""
        Exit Function
    End If

    startIndex = startIndex + Len(marker)

    Do While startIndex <= Len(jsonText) And Mid$(jsonText, startIndex, 1) = " "
        startIndex = startIndex + 1
    Loop

    If Mid$(jsonText, startIndex, 1) = """" Then
        startIndex = startIndex + 1

        Dim stringEndIndex As Long
        stringEndIndex = InStr(startIndex, jsonText, """")
        If stringEndIndex = 0 Then
            GetJsonValue = ""
        Else
            GetJsonValue = Mid$(jsonText, startIndex, stringEndIndex - startIndex)
        End If

        Exit Function
    End If

    Dim commaIndex As Long
    Dim braceIndex As Long
    Dim endIndex As Long

    commaIndex = InStr(startIndex, jsonText, ",")
    braceIndex = InStr(startIndex, jsonText, "}")

    If commaIndex = 0 Then
        endIndex = braceIndex
    ElseIf braceIndex = 0 Then
        endIndex = commaIndex
    ElseIf commaIndex < braceIndex Then
        endIndex = commaIndex
    Else
        endIndex = braceIndex
    End If

    If endIndex = 0 Then
        GetJsonValue = Trim$(Mid$(jsonText, startIndex))
    Else
        GetJsonValue = Trim$(Mid$(jsonText, startIndex, endIndex - startIndex))
    End If
End Function