災害ボランティア検索APIをVBScriptから呼び出してみます(エラー処理等手抜き)。
※ 要アプリケーションID
Option Explicit
Dim oXML
Dim oNode
Dim url
Dim status
Dim q '検索クエリー
Const AppID = "(アプリケーションID)" 'アプリケーションID
q = InputBox("検索文字列を入力してください。")
If IsEmpty(q) Then WScript.Quit
If q = "" Then WScript.Quit
url = "http://shinsai.yahooapis.jp/v1/volunteers?appid=" & AppID & "&query=" & EncodeURL(q)
Set oXML = GetXMLDocument(url)
If oXML Is Nothing Then WScript.Quit
WScript.Echo "■災害ボランティア情報(検索キーワード：" & q & ")"
WScript.Echo "--------------------"
On Error Resume Next
For Each oNode In oXML.SelectNodes("/Messages/Message")
status = oNode.SelectSingleNode("Status").Text
Select Case CInt(status)
Case 0
status = "募集終了"
Case 1
status = "現在募集中"
Case Else
status = "募集状況不明"
End Select
WScript.Echo "募集メッセージのタイトル：" & oNode.SelectSingleNode("Title").Text & "(" & status & ")"
WScript.Echo "情報が最後に変更された時間：" & oNode.SelectSingleNode("UpdateTime").Text
WScript.Echo "場所：" & oNode.SelectSingleNode("Address").Text
WScript.Echo "組織名：" & oNode.SelectSingleNode("Organization").Text
WScript.Echo "募集メッセージ："
WScript.Echo oNode.SelectSingleNode("Body").Text
WScript.Echo "--------------------"
Next
If Err.Number <> 0 Then
WScript.Echo "エラーが発生しました。"
WScript.Echo "内容：" & Err.Description
Err.Clear
End If
On Error GoTo 0
Set oXML = Nothing
Public Function GetXMLDocument(ByVal url)
'XML取得
Dim oXML
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.Send
Set oXML = .responseXML
End With
If Err.Number <> 0 Then
Set oXML = Nothing
Err.Clear
End If
On Error GoTo 0
Set GetXMLDocument = oXML
End Function
Public Function EncodeURL(ByVal sWord)
'URLエンコード
Dim d
Dim elm
sWord = Replace(sWord, "\", "\\")
sWord = Replace(sWord, "'", "\'")
Set d = CreateObject("htmlfile")
Set elm = d.createElement("span")
elm.setAttribute "id", "result"
d.appendChild elm
d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & sWord & "');", "JScript"
EncodeURL = elm.innerText
End Function
結果はリダイレクトで受け取るのが良さそうです。
広告
