How to call a Rest API from Excel VBA script

call-rest-api-script.vbs

Dim cache As New Scripting.Dictionary

Sub ChangePartnerName()
    Application.ScreenUpdating = False

    Dim StartRange As String
    Dim EndRange As String
    
    ' first row is the header
    StartRange = "A2"
    EndRange = "A5"
    'EndRange = Range("C2").End(xlDown).Value
    
    Dim lastStateChange
    Dim state
    Dim i As Integer
    i = 0
    
   ' Set List = Range(StartRange, EndRange)
   Set List = Selection
    Dim name As String
    For Each cell In List
        Application.StatusBar = "Processing Sit ID " & cell.Value & ", position " & cell.Address(False, False)
        dateField = FetchSitField(cell, "xpath selector to unix timestamp")
        stringField = FetchSitField(cell, "xpath selector")
        cell.Offset(0, 4).Value = FormatUnixTimestamp(dateField)
        cell.Offset(0, 5).Value = stringField
        
        ' reactivate the UI sometime to let Excel update the StatusBar
        If i Mod 10 = 0 Then DoEvents
    Next cell
    
    
    'Call PrintDictionary(cache)
    
    Set cache = Nothing
    
    ' reset statusBar and ScreenUpdating
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub



Function FetchSitField(id, xpath_selector) As String

    Dim name As String
    Dim key As String
   
   ' cast to string
    key = "" & id
    
    If Not cache.Exists(key) Then
            xmldoc = FetchHTTP("http:// url here " & id)
        cache.Add key, xmldoc
        Debug.Print "HTTP response: "
    Else
        xmldoc = cache(key)
        Debug.Print "CACHE response: "
        
    End If
    
    FetchSitField = ReadXML(xpath_selector, xmldoc)
End Function

Private Function ReadXML(xpath_selector, xmltext)
    
    Set xmldoc = New MSXML2.DOMDocument60
    Dim textNode As String
    
    xmldoc.validateOnParse = False
    xmldoc.setProperty "SelectionNamespaces", "xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'"
    xmldoc.LoadXML (xmltext)
    textNode = xmldoc.SelectSingleNode(xpath_selector).Text
    
    ReadXML = Trim(textNode)

End Function

Private Function FetchHTTP(url)

    Dim result As String
    Dim winHttpReq As Object
    
    COOKIE = "session cookie here"
    
    
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    winHttpReq.Open "GET", url, False
    winHttpReq.setRequestHeader "Cookie", COOKIE
    winHttpReq.Send
    
    If winHttpReq.Status <> 200 Then
    MsgBox "HTTP Error: " & winHttpReq.Status
    Err.Raise Number:=vbObjectError + winHttpReq.Status, _
              Description:="HTTP Error: " & winHttpReq.Status
    End If
    
    FetchHTTP = winHttpReq.responseText
End Function

Private Function PrintDictionary(dict As Dictionary)
    For Each c In dict.Items()
        Debug.Print c
    Next c
End Function

Private Function FormatUnixTimestamp(ByVal unixTimestamp As Long)
 FormatUnixTimestamp = Format(Unix2Date(unixTimestamp), "dd-mm-yyyy hh:mm:ss")
End Function

Public Function Unix2Date(ByVal unixTimestamp As Long) As Date
Unix2Date = CDate(unixTimestamp / 86400 + 25569)
End Function