1

I have the following code which works GREAT, but occasionally will give users the following compile error:

Compile Error: Can't find project or library

I have no idea what is causing this and why it only occurs with about 10% of users. I have also ensured everyone using it has the following References enabled:

enter image description here

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
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
RCarmody
  • 712
  • 1
  • 12
  • 29
  • I don't see a missing reference indicated. You can convert this Dim getRequest As MSXML2.XMLHTTP60 to late bound CreateObject("MSXML2.XMLHTTP") – QHarr Mar 15 '19 at 20:04
  • You're using an external convertor, `JsonConverter`. In the *Project Explorer*, did you import the BAS file? If not, look [here](https://codingislove.com/excel-json/). – J VBA Mar 15 '19 at 23:53

0 Answers0