Пример доступа к данным из Excel — различия между версиями

Текущая версия на 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