Total Access: 8889406
停電事故 発生中 |
電柱番号 位置情報変換 を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
北海道電力ネットワーク㈱
一般社団法人 北海道電気管理技術者協会
長谷川電気管理事務所 長谷川博