Calling web APIs and parsing JSON in VBA

Make GET and POST requests with MSXML2 and WinHttp, set headers, parse JSON without a library, and handle timeouts and errors.

Making the request

Option Explicit

Public Function HttpGet(ByVal url As String, ByRef outError As String) As String
    Dim http As Object
    ' MSXML2.ServerXMLHTTP.6.0 supports timeouts: the plain XMLHTTP does not
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    On Error GoTo Fail

    http.Open "GET", url, False                  ' False = synchronous
    http.setTimeouts 5000, 5000, 10000, 30000    ' resolve, connect, send, receive
    http.setRequestHeader "Accept", "application/json"
    http.setRequestHeader "User-Agent", "ExcelVBA/1.0"
    http.send

    If http.Status < 200 Or http.Status >= 300 Then
        outError = "HTTP " & http.Status & ": " & Left$(http.responseText, 500)
        Exit Function
    End If

    HttpGet = http.responseText
    Exit Function

Fail:
    outError = "request failed: " & Err.Description
End Function

Public Function HttpPostJson(ByVal url As String, ByVal json As String, _
                             ByRef outError As String) As String
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    On Error GoTo Fail
    http.Open "POST", url, False
    http.setTimeouts 5000, 5000, 10000, 30000
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Accept", "application/json"
    http.send json

    If http.Status < 200 Or http.Status >= 300 Then
        outError = "HTTP " & http.Status & ": " & Left$(http.responseText, 500)
        Exit Function
    End If

    HttpPostJson = http.responseText
    Exit Function

Fail:
    outError = "post failed: " & Err.Description
End Function

Sub TryIt()
    Dim errText As String, body As String
    body = HttpGet("https://api.example.com/v1/status", errText)
    If Len(errText) > 0 Then
        Debug.Print errText
        Exit Sub
    End If
    Debug.Print Left$(body, 200)
End Sub

• Use ServerXMLHTTP, not XMLHTTP. Only the server version exposes setTimeouts; without it a stalled server hangs Excel until the user kills the process.
• Always check http.Status before reading responseText. A 404 or a 500 returns a body, and treating an error page as data is how a report ends up full of HTML.
• WinHttp.WinHttpRequest.5.1 is an alternative that also supports timeouts. It is stricter about TLS and does not follow redirects by default, so set http.Option(6) = True to enable them.
• A synchronous call blocks Excel completely. For a slow API, set Async = True and poll ReadyState, but do it with a bounded wait or you have built a hang.

Parsing JSON without a library

' A small recursive-descent parser. It is enough for the flat and
' one-level-nested JSON that most APIs return, and it needs no reference.
' For deeply nested or streaming JSON, use the JsonConverter library or
' call PowerShell's ConvertFrom-Json instead of extending this.

Private mJson As String
Private mPos As Long
Private mLen As Long

Public Function JsonParse(ByVal text As String) As Object
    mJson = text
    mPos = 1
    mLen = Len(text)
    Set JsonParse = ParseValue()
End Function

Private Function ParseValue() As Object
    SkipWs
    Dim c As String
    c = Mid$(mJson, mPos, 1)

    Select Case c
        Case "{"
            Set ParseValue = ParseObject()
        Case "["
            Set ParseValue = ParseArray()
        Case """"
            Set ParseValue = ParseString()
        Case "t", "f"
            ParseValue = (Mid$(mJson, mPos, 4) = "true")
            mPos = mPos + IIf(ParseValue, 4, 5)
        Case "n"
            mPos = mPos + 4
            Set ParseValue = Nothing
        Case Else
            ParseValue = ParseNumber()
    End Select
End Function

Private Function ParseObject() As Object
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    mPos = mPos + 1                            ' skip {

    Do
        SkipWs
        If Mid$(mJson, mPos, 1) = "}" Then mPos = mPos + 1: Exit Do
        If Mid$(mJson, mPos, 1) = "," Then mPos = mPos + 1

        Dim key As String
        key = ParseString()
        SkipWs
        mPos = mPos + 1                        ' skip :
        Set d(key) = ParseValue()              ' may be an object, array or scalar
    Loop

    Set ParseObject = d
End Function

Private Function ParseArray() As Object
    Dim c As Collection
    Set c = New Collection
    mPos = mPos + 1                            ' skip [

    Do
        SkipWs
        If Mid$(mJson, mPos, 1) = "]" Then mPos = mPos + 1: Exit Do
        If Mid$(mJson, mPos, 1) = "," Then mPos = mPos + 1
        c.Add ParseValue()
    Loop

    Set ParseArray = c
End Function

Private Sub SkipWs()
    Do While mPos <= mLen
        Select Case Mid$(mJson, mPos, 1)
            Case " ", vbTab, vbCr, vbLf: mPos = mPos + 1
            Case Else: Exit Do
        End Select
    Loop
End Sub

Private Function ParseString() As String
    ' handle the escapes you actually meet: \" \\ \n \t \uXXXX
    ' a full implementation must convert \uXXXX surrogate pairs
End Function

Private Function ParseNumber() As Double
    ' read while the character is a digit, a sign, a dot, e or E
End Function

If you control the endpoint, ask for CSV or a flat JSON object. Parsing is the fragile part of any VBA integration, and a flat response removes the need for a parser altogether.

Timeouts, credentials and retries

Public Function GetWithRetry(ByVal url As String, ByVal attempts As Long) As String
    Dim errText As String
    Dim body As String
    Dim attempt As Long

    For attempt = 1 To attempts
        errText = ""
        body = HttpGet(url, errText)
        If Len(errText) = 0 Then
            GetWithRetry = body
            Exit Function
        End If

        ' 4xx will not fix itself; only retry the transient cases
        If InStr(errText, "HTTP 4") > 0 Then Exit For
        Application.Wait Now + TimeSerial(0, 0, attempt)     ' linear backoff
    Next attempt

    Debug.Print "gave up after " & attempts & " attempts: " & errText
End Function

Public Sub WithAuthHeader()
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    http.Open "GET", "https://api.example.com/v1/me", False
    http.setRequestHeader "Authorization", "Bearer " & GetToken()
    http.send
    Debug.Print http.Status
End Sub

Private Function GetToken() As String
    ' NEVER hard-code a token in the module. Read it from a protected place.
    Dim env As String
    env = Environ$("API_TOKEN")
    If Len(env) = 0 Then
        Err.Raise vbObjectError + 2001, "GetToken", "API_TOKEN is not set"
    End If
    GetToken = env
End Function

FAQ

Related

Files and folders: FileSystemObject and TextStream Strings, dates and number formatting

Last refreshed 2026-09-18.