Skip to content

Instantly share code, notes, and snippets.

Last active May 31, 2024 08:00
Show Gist options
  • Save loru88/7ee7435e1b538ca860331ed49f50b060 to your computer and use it in GitHub Desktop.
Save loru88/7ee7435e1b538ca860331ed49f50b060 to your computer and use it in GitHub Desktop.
How to call a Rest API from Excel VBA script
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: "
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=''"
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
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment