I am running a macro which is using ScriptControl and parsing data with JSON. Now I need to get rid of ScriptControl due the security policies in the company. Microsoft is not updating ScriptControl anymore and to run the macro I need to install one specific DLL to allow the macro runs in 64b Excel as 32b. So, is there any other way to replace the ScriptControl in the macro?
Below is the example of part of code where ScripControl is set. I appreciate any advice.
Dim s As Object: Set s = CreateObject("ScriptControl")
Dim myArray() As Variant: myArray = Array("DateTime", "Connections", "?", "?", "Container", "Event", "Lane", "Status")
Dim H As Object: Set H = CreateObject("WinHTTP.WinHTTPRequest.5.1")
Dim URL As String: URL = "https://source/source/source/search"
Dim Payload As String: Payload = Sheet16.Range("G8")
Dim snapShot As String: snapShot = Format(Now(), "DDD, DD MMM YYYY HH:NN:SS") & " GMT"
Dim LastR As Long: LastR = Cells(Rows.Count, 1).End(xlUp).row
s.Language = "JScript"
s.AddCode "function k(a){var k=[];for(var b in a){k.push(b);}return k;}"
With H
.Open "GET", URL
.SetAutoLogonPolicy 0
.send ""
.Open "POST", URL
.SetAutoLogonPolicy 0
.SetRequestHeader "Content-Type", "application/json;charset=utf-8"
.SetRequestHeader "date", snapShot
.send Payload & "null" & "}"
.waitForResponse
End With
s.Eval ("var J = " & H.ResponseText)
'clear previous data
Sheet17.Range("A:Z").Cells.ClearContents
Sheet15.Range("A:I").Cells.ClearContents
For x = 0 To s.Eval("J.messages.length") - 1
On Error Resume Next
Sheet15.Cells(x + 2, 2) = s.Eval("J.messages['" & x & "'].connectionName")
Sheet17.Cells(x + 2, 1) = s.Eval("J.messages['" & x & "'].rawMessage")
Sheet17.Cells(x + 2, 2) = s.Eval("J.messages['" & x & "'].comment")
Sheet17.Cells(x + 2, 3) = s.Eval("J.messages['" & x & "'].timestamp")
Next x
'Retrieve next token and loop
Sheet16.Range("K4") = s.Eval("J.nextToken")
NextToken = Sheet16.Range("K3")
Do Until NextToken = """"""
GoTo getNextToken
getNextToken:
With H
.Open "GET", URL
.SetAutoLogonPolicy 0
.send ""
.Open "POST", URL
.SetAutoLogonPolicy 0
.SetRequestHeader "Content-Type", "application/json;charset=utf-8"
.SetRequestHeader "date", snapShot
.send Payload & NextToken & "}"
.waitForResponse
End With
s.Eval ("var J = " & H.ResponseText)
For y = 0 To s.Eval("J.messages.length") - 1
On Error Resume Next
Sheet15.Cells(x + 2, 2) = s.Eval("J.messages['" & x & "'].connectionName")
Sheet17.Cells(x + 2, 1) = s.Eval("J.messages['" & x & "'].rawMessage")
Sheet17.Cells(x + 2, 2) = s.Eval("J.messages['" & x & "'].comment")
Sheet17.Cells(x + 2, 3) = s.Eval("J.messages['" & x & "'].timestamp")
x = x + 1
Next y
'Retrieve next token and loop
Sheet16.Range("K4") = s.Eval("J.nextToken")
NextToken = Sheet16.Range("K3")
Loop
Call delimitFlowData
Dim lastrow As Long: lastrow = Sheet17.Cells(Rows.Count, 3).End(xlUp).row
Dim fillRange As Range: Set fillRange = Sheet15.Range("A2:A" & lastrow)
Sheet15.Range("A2").Formula = ("=FlowSort!$C2 - TIME(6,0,0)")
Sheet15.Range("A2").AutoFill Destination:=fillRange
Sheet17.Range("D2:I" & lastrow).Copy Sheet15.Range("C2:H" & lastrow)
Sheet15.Range("A1:H1") = myArray()
Sheet15.Columns.AutoFit
End Sub ```