Werte von Webserver auslesen

Code:

Option Explicit



Sub StartPolling()



    If Worksheets(1).Buttons("Button_PollPD").Caption = "Start polling" Then

        Worksheets(1).Buttons("Button_PollPD").Caption = "End polling"

        Call StartQuery(Cells(2, 2), Cells(3, 2), Worksheets(1))

    Else

        Worksheets(1).Buttons("Button_PollPD").Caption = "Start polling"

        StopQuery

    End If

    

End Sub

Code:

Dim timerActive As Boolean

Dim ipAddress As String

Dim activePort As String

Dim currentSheet As Worksheet



Private Sub ParseProcessdataJSON(data As String)

    Dim scriptControl As Object

    Dim json As Object

    

    Set scriptControl = CreateObject("MSScriptControl.ScriptControl")

    scriptControl.Language = "JScript"

    

    Set json = scriptControl.Eval("(" + data + ")")

    

    With currentSheet

        Dim dataObj As Object

        Set dataObj = CallByName(json, "data", VbGet)

        .Cells(8, 3) = CallByName(dataObj, "isValid", VbGet)

        Set processdatainObj = CallByName(dataObj, "processDataIn", VbGet)

        Dim arrayLength As Variant

        arrayLength = CInt(CallByName(processdatainObj, "length", VbGet))

        Dim strPD As String

        For i = 0 To arrayLength - 1

            strPD = strPD + CStr(CallByName(processdatainObj, CStr(i), VbGet))

            If i < arrayLength - 1 Then

                strPD = strPD + ", "

            End If

        Next

        .Cells(8, 2) = strPD

    End With

End Sub



Private Sub QueryRESTProcessData()



    Dim objRequest As Object

    Dim strUrl As String

    Dim strResponse As String

    Dim strBody As String

    Dim portNo As Variant



    Set objRequest = CreateObject("MSXML2.XMLHTTP")

    strUrl = "http://" + ipAddress + "/iolink/sickv1/readPort"



    portNo = CInt(activePort) - 1

    strBody = "{""header"":{""portNumber"":" + CStr(portNo) + "},""data"":{""processData"":""in""}}"



    With objRequest

        .Open "POST", strUrl, False

        .SetRequestHeader "Content-Type", "application/json"

        .SetRequestHeader "Accept", "application/json" ''Content-Type: application/json'

        .Send (strBody)

        strResponse = .ResponseText

    End With



    Debug.Print strResponse

    

    Call ParseProcessdataJSON(strResponse)

    

    currentSheet.Cells(8, 1) = "Port " + activePort

    

    If (timerActive = True) Then

        Application.OnTime Now() + TimeValue("00:00:01"), "QueryRESTProcessData"

    End If

End Sub



Sub StartQuery(ipAddr, port, sheet As Worksheet)

    ipAddress = ipAddr

    activePort = port

    Set currentSheet = sheet

    

    timerActive = True

    Application.OnTime Now() + TimeValue("00:00:01"), "QueryRESTProcessData"

End Sub



Sub StopQuery()

        timerActive = False

End Sub