APIで郵便番号から住所を取得する(2)

今回はGroove Technologyが提供しているAPIで住所検索してみます。
郵便番号から住所、住所から郵便番号の取得が可能。

Option Explicit
Option Base 1

Private Type Address
  zipcode As String '郵便番号
  add As String '住所
  addk As String '住所(カナ)
End Type

Public Sub Sample()
  Dim ad() As Address, ad2() As Address
  Dim count As Long, count2 As Long
  Dim i As Long, j As Long
  
  '郵便番号による住所検索
  ad() = AddressByZipCodeOrAddress("111")
  On Error Resume Next
  count = UBound(ad)
  If Err.Number <> 0 Then
    MsgBox "住所を取得できませんでした。", vbCritical + vbSystemModal
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
  For i = LBound(ad) To count
    Debug.Print ad(i).zipcode, ad(i).add, ad(i).addk
  Next
  
  Debug.Print "--------------------"
  
  '住所の一部による住所検索
  ad2() = AddressByZipCodeOrAddress("沖縄県那覇市首里", 2)
  On Error Resume Next
  count2 = UBound(ad2)
  If Err.Number <> 0 Then
    MsgBox "住所を取得できませんでした。", vbCritical + vbSystemModal
    Err.Clear
    Exit Sub
  End If
  On Error GoTo 0
  For j = LBound(ad2) To count2
    Debug.Print ad2(j).zipcode, ad2(j).add, ad2(j).addk
  Next
End Sub

Private Function AddressByZipCodeOrAddress(ByVal param As String, Optional ByVal mode As Long = 1) As Address()
'郵便番号もしくは住所の一部から住所を取得
'引数 mode 1:郵便番号 , 2:住所の一部(漢字、ひらがな、カタカナ)
  Dim ad() As Address
  Dim oXML As Object, oNode As Object
  Dim url As String, tmpZipcode As String
  Dim count As Long, i As Long
  
  url = "http://groovetechnology.co.jp/ZipSearchService/v1/zipsearch?format=xml&ie=UTF-8&oe=UTF-8"
  Select Case mode
    Case 1
      url = url & "&zipcode=" & param
    Case 2
      url = url & "&word=" & EncodeURL(param)
    Case Else
      MsgBox "不正なパラメータです。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal
      Exit Function
  End Select
  
  count = 0: i = 1 '初期化
  On Error Resume Next
  Set oXML = Nothing
  With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .Send
    Set oXML = .responseXML
  End With
  Err.Clear
  On Error GoTo 0
  If oXML Is Nothing Then Exit Function
  If Len(oXML.XML) < 1 Then Exit Function
  count = oXML.SelectNodes("/groovewebservice/address").Length
  If count < 1 Then Exit Function
  
  ReDim ad(count)
  For Each oNode In oXML.SelectNodes("/groovewebservice/address")
    tmpZipcode = oNode.SelectSingleNode("zipcode").Text
    tmpZipcode = Left$(tmpZipcode, 3&) & "-" & Right$(tmpZipcode, 4&)
    ad(i).zipcode = tmpZipcode
    ad(i).add = oNode.SelectSingleNode("prefecture").Text & _
                oNode.SelectSingleNode("city").Text & _
                oNode.SelectSingleNode("town").Text
    ad(i).addk = oNode.SelectSingleNode("prefecture_yomi").Text & _
                 oNode.SelectSingleNode("city_yomi").Text & _
                 oNode.SelectSingleNode("town_yomi").Text
    i = i + 1
  Next
  
  AddressByZipCodeOrAddress = ad()
End Function

Private Function EncodeURL(ByVal sWord As String) As String
  Dim d As Object
  Dim elm As Object
  
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.body.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人のブロガーが「いいね」をつけました。