In general, I think using IE automation should be avoided where possible, especially if you can figure out a method to emulate this request via a web request.
A little background on this method
I'm submitting two web requests. One to get an authorization token, and another to get the the JSON from the page which populate the widgets on screen. I figured this out by studying the web requests sent back and forth between the client (me) and the server, and emulated those requests.The approach outlined below is pretty fast, about 2 seconds without URL decoding, and 10 seconds with decoding.
Things you'll need for this to work
- Explicit Reference set to Microsoft XML v6.0
- Explicit Reference set to Microsoft Scripting Runtime
- The VBA-JSON project included into your project, get that here
Code
I split out token and json retrieval into two functions. What you get back from getJSON is a dictionary. This dictionary is somewhat nested, so you refer to items by key to traverse the dictionary down. E.g. MyDict(property1)(childPropertyOfproperty1)(childPropertyOf...) etc.
Here's the code.
Option Explicit
Public Sub SubmitRequest()
Const URL As String = "https://app.mural.co/t/hanno1/m/hanno1/1488557783266/465baa38d35e95edc969a5ca9e2a8bb8b6f10310"
Dim returnobject As Object
Dim widgets As Object
Dim widget As Variant
Dim WidgetArray As Variant
Dim id As String
Dim i As Long
Set returnobject = getJSON(URL, getToken(URL))
Set widgets = returnobject("widgets")
ReDim WidgetArray(0 To 7, 0 To 10000)
For Each widget In widgets
'Only add if a text item, change if you like
If returnobject("widgets")(widget)("type") = "murally.widget.TextWidget" Then
WidgetArray(0, i) = URLDecode(returnobject("widgets")(widget)("properties")("text"))
WidgetArray(1, i) = returnobject("widgets")(widget)("properties")("fontSize")
WidgetArray(2, i) = returnobject("widgets")(widget)("properties")("backgroundColor")
WidgetArray(3, i) = returnobject("widgets")(widget)("x")
WidgetArray(4, i) = returnobject("widgets")(widget)("y")
WidgetArray(5, i) = returnobject("widgets")(widget)("width")
WidgetArray(6, i) = returnobject("widgets")(widget)("height")
WidgetArray(7, i) = returnobject("widgets")(widget)("id")
i = i + 1
End If
Next
ReDim Preserve WidgetArray(0 To 7, i - 1)
With ThisWorkbook.Worksheets("Sheet1")
.Range("A1:H1") = Array("Text", "FontSize", "BackgroundColor", "X Position", "Y Position", "Width", "Height", "ID")
.Range(.Cells(2, 1), .Cells(i+ 1, 8)).Value = WorksheetFunction.Transpose(WidgetArray)
End With
End Sub
Public Function getJSON(URL As String, Token As String) As Object
Dim baseURL As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim jsonconvert As Object
Dim id As String
dim user as String
URLParts = Split(URL, "/", , vbBinaryCompare)
id = URLParts(UBound(URLParts) - 1)
user = URLParts(UBound(URLParts) - 2)
baseURL = Replace(Replace("https://app.mural.co/api/murals/{user}/{ID}", "{ID}", id), "{user}", user)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "GET", baseURL
.setRequestHeader "Authorization", "Bearer " & Token
.setRequestHeader "Referer", URL
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.send
Set getJSON = JsonConverter.ParseJson(.responseText)
End With
End Function
Public Function getToken(URL As String) As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim position As Long
Dim jsonconvert As Object
Dim Token As Object
Dim State As String
Dim User As String
Dim json As String
Dim referer As String
Dim id As String
Dim posturl As String
json = "{""state"": ""{STATE}""}"
posturl = "https://app.mural.co/api/v0/visitor/{user}.{ID}"
referer = "https://app.mural.co/t/{user}/m/{user}/{ID}"
URLParts = Split(URL, "/", , vbBinaryCompare)
position = InStrRev(URL, "/")
URL = Left$(URL, position - 1)
State = URLParts(UBound(URLParts))
id = URLParts(UBound(URLParts) - 1)
User = URLParts(UBound(URLParts) - 2)
json = Replace(json, "{STATE}", State)
posturl = Replace(Replace(posturl, "{user}", User), "{ID}", id)
referer = Replace(Replace(referer, "{user}", User), "{ID}", id)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "POST", posturl
.setRequestHeader "origin", "https://app.mural.co"
.setRequestHeader "Referer", referer
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.send json
Set jsonconvert = JsonConverter.ParseJson(.responseText)
End With
getToken = jsonconvert("token")
End Function
' from https://stackoverflow.com/a/12804172/4839827
Public Function URLDecode(ByVal StringToDecode As String) As String
With CreateObject("htmlfile")
.Open
.Write StringToDecode
.Close
URLDecode = .body.outerText
End With
End Function
Here's the output returned. There are other properties available, however this code is meant to just give you an idea how to pull this back.
