今回は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
    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
  Debug.Print "--------------------"
  ad2() = AddressByZipCodeOrAddress("沖縄県那覇市首里", 2)
  On Error Resume Next
  count2 = UBound(ad2)
  If Err.Number <> 0 Then
    MsgBox "住所を取得できませんでした。", vbCritical + vbSystemModal
    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
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
    Set oXML = .responseXML
  End With
  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 & _
    ad(i).addk = oNode.SelectSingleNode("prefecture_yomi").Text & _
                 oNode.SelectSingleNode("city_yomi").Text & _
    i = i + 1
  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 アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

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

Twitter 画像

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

Facebook の写真

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

%s と連携中