Is it possible to replace ScriptControl in VBA to another valid object?

362 Views Asked by At

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 ```
0

There are 0 best solutions below