====== An example of getting WebHMI data from Excel ======
There is a detailed explanation about this functions [[access_via_api|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 {{ network:api_example.zip |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 {{ network:webhmi_registers_read_and_write.zip |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: {{ network:webhmi_registers_log_read.zip |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