Total Access: 8889406


停電事故 発生中

北電NW「電柱番号 位置情報変換」隠しAPIをExcelVBAから使う

電柱番号 位置情報変換 をChromeのデベロッパーツール等を駆使することで,このようなアクセス で座標をJSONで返す機能が隠されている事を見抜けます.

これをExcelVBAから取得するサンプルです.実行するとイミディエイトウィンドウに表示されます.

Sub GetLatLngFromURL()

    Dim objHTTP As Object
    Dim URL As String
    Dim jsonResponse As String
    Dim lat As Double
    Dim lng As Double
    Dim latStartPos As Long
    Dim lngStartPos As Long
    Dim commaPos As Long
    Dim endBracePos As Long
    Dim latString As String
    Dim lngString As String

    '//アクセスするURL
    URL = "https://haiden.hokuden-network.biz/denchu/api/pole/415263115464/latlng"

    '//Microsoft XMLHTTPオブジェクト作成
    '//ツール -> 参照設定 から "Microsoft XML, v6.0" にチェックを入れるか,
    '//または CreateObject("MSXML2.XMLHTTP") を使用します.
    '//ここでは参照設定が不要な CreateObject を使用します.
    On Error Resume Next
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    If objHTTP Is Nothing Then
        MsgBox "MSXML2.XMLHTTP オブジェクトの作成に失敗しました.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0 ' エラーハンドリングをリセット

    '//GETリクエストを準備
    objHTTP.Open "GET", URL, False ' False は同期リクエスト

    '//リクエストを送信
    objHTTP.Send

    '//レスポンスステータス確認
    If objHTTP.Status = 200 Then
        '//成功した場合,レスポンステキスト取得
        jsonResponse = objHTTP.ResponseText

        ' "lat": の位置を探す
        latStartPos = InStr(jsonResponse, """lat"":")
        ' "," の位置を探す
        commaPos = InStr(jsonResponse, ",")

        ' 抽出処理
        If latStartPos > 0 And commaPos > latStartPos Then
            ' "lat": の値部分を抽出
            latString = Mid(jsonResponse, latStartPos + Len("""lat"":"), commaPos - (latStartPos + Len("""lat"":")))
            ' 抽出した文字列を数値に変換
            On Error Resume Next
            lat = CDbl(Trim(latString))
            If Err.Number <> 0 Then
                MsgBox "緯度の変換に失敗しました: " & latString, vbExclamation
                Err.Clear
            End If
            On Error GoTo 0
        Else
            MsgBox "JSONから緯度が見つかりませんでした.", vbExclamation
        End If

        ' "lng": の位置を探す
        lngStartPos = InStr(commaPos, jsonResponse, """lng"":")
        ' "}" の位置を探す
        endBracePos = InStr(jsonResponse, "}")

        ' 抽出処理
        If lngStartPos > 0 And endBracePos > lngStartPos Then
            ' "lng": の値部分を抽出
            lngString = Mid(jsonResponse, lngStartPos + Len("""lng"":"), endBracePos - (lngStartPos + Len("""lng"":")))
             ' 抽出した文字列を数値に変換
            On Error Resume Next
            lng = CDbl(Trim(lngString))
             If Err.Number <> 0 Then
                MsgBox "経度の変換に失敗しました: " & lngString, vbExclamation
                Err.Clear
            End If
            On Error GoTo 0
        Else
            MsgBox "JSONから経度が見つかりませんでした.", vbExclamation
        End If

        '//取得した緯度・経度を表示
        Debug.Print "緯度 (lat): " & lat
        Debug.Print "経度 (lng): " & lng

    Else
        '//失敗した場合,ステータスコードを表示
        MsgBox "データ取得に失敗しました.ステータスコード: " & objHTTP.Status, vbExclamation
    End If

    Set objHTTP = Nothing '//オブジェクト解放

End Sub


北海道電力ネットワーク㈱
一般社団法人 北海道電気管理技術者協会
長谷川電気管理事務所 長谷川博