災害ボランティア検索APIをVBScriptから呼び出す

災害ボランティア検索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

結果はリダイレクトで受け取るのが良さそうです。

広告

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト / 変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト / 変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト / 変更 )

Google+ フォト

Google+ アカウントを使ってコメントしています。 ログアウト / 変更 )

%s と連携中


%d人のブロガーが「いいね」をつけました。