Excel VBAでESP32のセンサデータをロギングする ～JSON APIで簡単に記録する方法～

Option Explicit

Const ESP32_URL As String = "http://192.168.0.20/api"

Dim http As Object

Private Sub InitHttp()
    If http Is Nothing Then
        Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
        http.SetTimeouts 1000, 1000, 3000, 3000
    End If
End Sub


Sub LogSensors()

    On Error GoTo ErrHandler
    InitHttp

    http.Open "POST", ESP32_URL, False
    http.SetRequestHeader "Content-Type", "application/json"
    http.Send "{""cmd"":""get_sensors""}"

    If http.status <> 200 Then
        LogError "HTTP Error: " & http.status
        Exit Sub
    End If

    Dim js As Object
    Set js = JsonConverter.ParseJson(http.ResponseText)

    Dim ts As Variant
    ts = Now

    If Not js.Exists("inventory") Then
        LogError "inventory missing"
        Exit Sub
    End If

    Dim inv As Object
    Set inv = js("inventory")

    Dim dev As Variant
    For Each dev In inv.Keys

        If inv(dev) = True And js.Exists(dev) Then
            Call LogJsonObject(ts, dev, js(dev))
        End If

    Next dev

    Exit Sub

ErrHandler:
    LogError Err.Description

End Sub


' ============================================================
' 汎用 JSON 展開ロガー（再帰対応）
' ============================================================
Private Sub LogJsonObject(ts As Variant, device As Variant, obj As Variant)
    Dim ws As Worksheet
    Set ws = Sheets("DataLog")

    Dim r As Long
    r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

    Dim key As Variant

    ' --- 配列（Collection） ---
    If TypeName(obj) = "Collection" Then

        Dim i As Long
        For i = 0 To obj.Count - 1
            ws.Cells(r, 1).Value = ts
            ws.Cells(r, 2).Value = device
            ws.Cells(r, 3).Value = device & "_" & i
            ws.Cells(r, 4).Value = obj(i)
            r = r + 1
        Next i

        Exit Sub
    End If


    ' --- オブジェクト（Dictionary） ---
    If IsObject(obj) Then

        ' Dictionary の Keys を安全に列挙
        On Error GoTo NotDictionary
        For Each key In obj.Keys

            Dim v As Variant
            v = obj(key)

            Select Case TypeName(v)

                Case "Collection"
                    ' 配列
                    Dim j As Long
                    For j = 0 To v.Count - 1
                        ws.Cells(r, 1).Value = ts
                        ws.Cells(r, 2).Value = device
                        ws.Cells(r, 3).Value = key & "_" & j
                        ws.Cells(r, 4).Value = v(j)
                        r = r + 1
                    Next j

                Case "Dictionary", "Object"
                    ' ネストしたオブジェクト
                    Call LogJsonObject(ts, device & "." & key, v)

                Case Else
                    ' 単一値
                    ws.Cells(r, 1).Value = ts
                    ws.Cells(r, 2).Value = device
                    ws.Cells(r, 3).Value = key
                    ws.Cells(r, 4).Value = v
                    r = r + 1

            End Select

        Next key

        Exit Sub

NotDictionary:
        ' Keys が使えない場合は単一値として扱う
        ws.Cells(r, 1).Value = ts
        ws.Cells(r, 2).Value = device
        ws.Cells(r, 3).Value = "(value)"
        ws.Cells(r, 4).Value = obj
        Exit Sub

    End If


    ' --- 単一値（Double / String / Boolean） ---
    ws.Cells(r, 1).Value = ts
    ws.Cells(r, 2).Value = device
    ws.Cells(r, 3).Value = "(value)"
    ws.Cells(r, 4).Value = obj

End Sub



' --- ErrorLog ---
Private Sub LogError(msg As String)

    With Sheets("ErrorLog")

        Dim r As Long
        r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

        .Cells(r, 1).Value = Now
        .Cells(r, 2).Value = msg

    End With

End Sub

Option Explicit

Public NextTime As Date

Sub StartLogging()
    Call LogSensors
    NextTime = Now + TimeValue("00:00:10")
    Application.OnTime NextTime, "StartLogging"
End Sub

Sub StopLogging()
    On Error Resume Next
    Application.OnTime NextTime, "StartLogging", , False
End Sub