Пример доступа к данным из Excel — различия между версиями
(Отметить эту версию для перевода) |
м |
||
Строка 97: | Строка 97: | ||
If Response.StatusCode = WebStatusCode.Ok Then | If Response.StatusCode = WebStatusCode.Ok Then | ||
' Success, parse response | ' Success, parse response | ||
− | Dim | + | Dim RegValues As Object |
Set RegValues = Response.Data | Set RegValues = Response.Data | ||
Текущая версия на 09:11, 1 ноября 2018
Чтение данных из лога событий
Ниже приведен простой пример запроса из Excel к WebHMI API. В данном примере происходит чтение данных из лога событий. Данный пример использует Active-X объект и работает только на платформах Windows. Дополнительно используется библиотека для парсинга JSON-ответов.
Скачать пример Файл: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
Чтение и запись текущих значений регистров
Второй пример показывает как прочитать текущие значения регистров и записать новое значение в один из регистров. Данный пример использует библиотеку https://github.com/VBA-tools/VBA-Web
Скачать пример Файл: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 RegValues 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
Чтение лога регистров
Третий пример показывает как прочитать данные для регистров с ID=1 и 21 из лога регистров за последние 10 минут. Данный пример использует библиотеку https://github.com/VBA-tools/VBA-Web
Скачать пример: Файл: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