Excel郵便番号住所変換のHTTPリクエストをVBScriptで書いてみた
関連
ExcelのVBAでYahoo!路線情報からHTMLを取得して運賃を取得してみる
Excel 郵便番号→住所変換 MSXML2.XML HTTP.3.0
VBSCriptだけで書いてみる
BASP21を使った処理は書いた事があるが、標準機能だけで書いてみる。
改造は2点
1.一時ファイル名UUID化する。
2.バイナリ→テキスト変換はFunctionで完結する
UUIDの取得
VBSCriptの一時ファイル名取得(GetTempName)は重複が発生して、痛い思い出がある。その時の解決策は別であったが、今回はUUIDを使ってみた。これでも完全ではないらしい
UUID v4って規格?があるようで、同じ内容のサンプルが幾つかみつかったが今回はこちらを参考にした。
バイナリ→テキスト変換はFunctionで完結する
バイナリ情報を一時ファイルに書き込み、読み出しでテキスト変換するそうです。
この一時ファイル名を固定にしたくなかったので、UUIDを使ってみました。
'************************************************************
'関数ID :binReadTextAll
'説明 :バイナリデータをテキストで返す
' responseText は、euc か utf-8 のページの場合 unicode として変換されます
' Shift_Jis は、responseBody でいったんバイナリ保存してから、読み込む
'戻り値 :バイナリデータのテキスト
'************************************************************
Function binReadTextAll(binData)
Dim objFSO 'ファイルシステムオブジェクト
Dim oStream 'ADODB.Streamオブジェクト
Dim strTempFolder '一時フォルダ名
Dim strTempFile '一時ファイル名
Dim resStream 'テキストストリームオブジェクト
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
strTempFile = objFSO.GetSpecialFolder(2) '2:TemporaryFolder 特殊フォルダ
'strTempFile = strTempFile & "\"& objFSO.GetTempName() '一時ファイル名 GetTempName では重複する場合がある
strTempFile = strTempFile & "\"& UUID() '一時ファイル名
Set oStream = CreateObject("ADODB.Stream") '一時ファイルへバイナリデータを書き込む
oStream.Open
oStream.Type = 1 ' バイナリ
oStream.Write binData
oStream.SaveToFile strTempFile
oStream.Close
Set resStream = objFSO.OpenTextFile(strTempFile, 1) '一時ファイルから読み出す
binReadTextAll = resStream.ReadAll
resStream.Close
objFSO.DeleteFile strTempFile '一時ファイル削除
Set resStream = Nothing
Set oStream = Nothing
Set objFSO = Nothing
End Function
HTTPリクエスト
HTTPリクエスト
' 参考先 https://necoyama3.hatenablog.com/entry/20090424/1240592349
'************************************************************
Dim oXMLHTTP ' MSXMLオブジェクト
Dim resData ' レスポンス
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
oXMLHTTP.Open "GET", URL, False ' FALSE:同期処理
oXMLHTTP.Send ' 受信
If oXMLHTTP.Status = 200 Then
resData = binReadTextAll(oXMLHTTP.responseBody)
MsgBox resData
Else
resData = "Error returnCode:" & oXMLHTTP.Status
MsgBox resData
End If
set oXMLHTTP = nothing