An example of getting WebHMI data from Excel
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-CONNS", "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-REG-IDS", "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