An example of getting WebHMI data from Excel

There is a detailed explanation about this functions here

Getting data from event log

Below is a simple example of a query from Excel to the WebHMI API. In this example, data is read from the event log. This example uses an Active-X object and works only on Windows platforms. Additionally, a library is used for parsing JSON responses.

Download the example API Example.xlsm

Const URl As String = "http://192.168.0.1/api/event-data/1"
Sub xmlHttp()

    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    xmlHttp.Open "GET", URl, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.setRequestHeader "Accept", "application/json"
    xmlHttp.setRequestHeader "Host", "192.168.0.1"
    xmlHttp.setRequestHeader "Cookie", " "
    xmlHttp.setRequestHeader "X-WH-APIKEY", "6E51E728896794EBF406E2F070BE7AFBE49E90D4"
    xmlHttp.setRequestHeader "X-WH-START", "1388948941"
    xmlHttp.setRequestHeader "X-WH-END", "1399208143"
    xmlHttp.send


    Dim JSON As New JSON

    Dim p As Object
    Set p = JSON.parse(xmlHttp.ResponseText)
    
    i = 2
    j = 1
    For Each Item In p ' rows
       If (j = 1) Then
          Cells(i, j).NumberFormat = "yyyy-mm-dd hh:mm:ss"
       End If
       If (j = 2) Then
          Cells(i, j).NumberFormat = "#.#" '"$#,##0.00_);[Red]($#,##0.00)"
       End If
       For Each Item2 In Item 'columns
         For Each Item3 In Item2
           If (j = 1 And i > 1) Then
             Cells(i, j) = (Item2(Item3) / 86400) + 25569
           Else
            Cells(i, j) = Item2(Item3)
           End If
           
           Cells(1, j) = Item3
         Next
        j = j + 1
       Next
         i = i + 1
         j = 1
       
    Next
   
 End Sub

Reading/Writing current register values

The second example shows how to read the current values of the registers and write the new value into one of the registers. This example uses the https://github.com/VBA-tools/VBA-Web library

Download the example WebHMI registers read and write.xlsm

Sub GetRegisters()    
    Dim Client As New WebClient
    Client.BaseUrl = "http://192.168.1.1/api"
    
    Dim Request As New WebRequest
    Request.Resource = "register-values"
    
    Request.Method = WebMethod.HttpGet
    Request.RequestFormat = WebFormat.JSON
    Request.ResponseFormat = WebFormat.JSON
    
    ' API KEY
    Request.AddHeader "X-WH-APIKEY", "EBB484265A64A547411FAC660AE3710CAA797976"
    
    ' IDs of connections to read register values from; comma-separated
    Request.AddHeader "X-WH-CONNECTIONS", "1,2"
    
    Dim Response As WebResponse
    Set Response = Client.Execute(Request)
    Cells.Range("A2:C1000").Clear

    If Response.StatusCode = WebStatusCode.Ok Then
       ' Success, parse response
       Dim RegValue As Object
       Set RegValues = Response.Data
        
       i = 3
       For Each strKey In RegValues.Keys() ' rows
        Cells(i, 1) = RegValues(strKey)("r")
        Cells(i, 2) = RegValues(strKey)("v")
        Cells(i, 3) = RegValues(strKey)("s")
        i = i + 1
      Next
    Else
      ' Error, show message
      Cells(3, 1) = "Error"
      Cells(3, 2) = Response.StatusCode
      Cells(3, 3) = Response.Content
    End If
    
End Sub

Sub WriteValue()
    Cells(1, 9) = "Writing..."
    Dim Client As New WebClient
    Client.BaseUrl = "http://192.168.1.1/api"
    
    Dim Request As New WebRequest
    Request.Resource = "register-values/{Id}"
    
    Request.Method = WebMethod.HttpPut
    Request.RequestFormat = WebFormat.JSON
    Request.ResponseFormat = WebFormat.JSON
    
    Request.AddBodyParameter "value", Cells(2, 7)
    Request.AddUrlSegment "Id", Cells(1, 7)
    
    Request.AddHeader "X-WH-APIKEY", "8DA00F5F9B42A8D070651C58F495DB1C3191AF19"
    
    Dim Response As WebResponse
    Set Response = Client.Execute(Request)
    
    If Response.StatusCode = WebStatusCode.Ok Then
        ' Success
        Cells(2, 10) = "OK"
        Application.Wait (Now + TimeValue("00:00:01")) ' Need to wait for PLC to be updated
        Call GetRegisters
    Else
        ' Error, display error
        Cells(2, 10) = "ERROR: " + Response.Content
    End If
    
End Sub

Reading register log

The third example shows how to read data for registers with ID = 1 and 21 from the logged during the last 10 minutes. This example uses the https://github.com/VBA-tools/VBA-Web library

Download the example: WebHMI registers log read.xlsm

Function NextSun(d1 As Date) As Date
    'if 24.3 or 24.10 is sunday returns 31.3 or 31.10
    If Weekday(d1, vbMonday) = 7 Then
        NextSun = d1 + 7
    Else
        'if not return nearest sunday
        NextSun = d1 + 7 - Weekday(d1, vbMonday)
    End If
End Function
    
Function IsDST(ByVal d0 As Date) As Boolean
   IsDST = d0 >= NextSun("24/3/" & Year(d0) & " 01:59:59") And d0 < NextSun("24/10/" & Year(d0) & " 01:59:59")
End Function

Function Date2Unixtime(inDate As Date) As Long
   ' Set your timezone offset here
   timeZoneOffset = 2 ' EET
    unixtime = DateDiff("s", "01/01/1970 00:00:00", inDate)

    'check if it is summer time
    If IsDST(inDate) = False Then
        unixtime = unixtime
    Else
        unixtime = unixtime - 3600
    End If
    Date2Unixtime = unixtime - 60 * 60 * timeZoneOffset
End Function

Function Epoch2Date(lngDate As Long) As Date
    ' Set your timezone here
    timeZoneOffset = 2 ' EET
    'transfer to date
    Epoch2Date = (lngDate + 60 * 60 * timeZoneOffset) / 86400# + #1/1/70#
    'check if it is summer time
    If IsDST(Epoch2Date) = False Then
        'here you can use diferent values depend on time zone
        Epoch2Date = Epoch2Date
    Else
        Epoch2Date = Epoch2Date + 1 / 24
    End If
End Function

Sub GetRegistersLog()
    
    Dim Client As New WebClient
    Client.BaseUrl = "http://192.168.1.254/api"
    Client.TimeoutMs = 15000
    
    Dim Request As New WebRequest
    Request.Resource = "register-log"
    
    Request.Method = WebMethod.HttpGet
    Request.RequestFormat = WebFormat.JSON
    Request.ResponseFormat = WebFormat.JSON
    
    Request.AddHeader "X-WH-START", Date2Unixtime(Now()) - 60 * 10 ' get data for last 10 minutes
    Request.AddHeader "X-WH-END", Date2Unixtime(Now())
        
    ' Set your API Key here
    Request.AddHeader "X-WH-APIKEY", "EBB484265A64A547411FAC660AE3710CAA797976"
     
    ' Set register IDs here. Comma-separated value
    Request.AddHeader "X-WH-REGISTERS", "1,21"
    
    Dim Response As WebResponse
    Set Response = Client.Execute(Request)
    Cells.Range("A4:J5000").Clear

    If Response.StatusCode = WebStatusCode.Ok Then
        ' Success, parse response
        Dim RegValue As Object
        Set RegValues = Response.Data
        If Response.Content = "[]" Then
            Cells(4, 1) = "No data"
            Cells(4, 2) = "No data"
            Cells(4, 3) = "No data"
            Cells(4, 4) = "No data"
            Cells(4, 5) = "No data"
            Cells(4, 6) = "No data"
            Cells(4, 7) = "No data"
            Cells(4, 8) = "No data"
        Else
              For i = 1 To RegValues.Count
                Cells(i + 3, 1) = RegValues(i)("t")
                Cells(i + 3, 2) = Epoch2Date(CLng(RegValues(i)("t")))
                Cells(i + 3, 2).NumberFormat = "yyyy-mm-dd hh:mm:ss"
                Cells(i + 3, 3) = RegValues(i)("r")
                Cells(i + 3, 4) = RegValues(i)("v")
                Cells(i + 3, 5) = RegValues(i)("s")
              Next
        End If
    End If
    
End Sub

WebHMI Docs

Table of Contents

An example of getting WebHMI data from Excel

Getting data from event log

Reading/Writing current register values

Reading register log