AccessにGoogleMapsAPIを埋め込む(1)

Microsof Office Accessは、とても便利で使い易いデータベースソフトですが、スタンドアロンもしくは小規模オフィスでのリレーショナルDBとしての利用を想定して設計されたものなので、Web連携機能はあまり充実しているとはいえません。
そのため、Web上で動作するGoogleMapsAPIとの相性は良いとは言えず、Accessアプリケーションにてこの機能を利用する例をインターネット上で探してみてもなかなか見つかりません(きちんと探せば沢山あるのでしょうが・・・)。
しかし、GoogleMapsAPIはインターネット接続環境さえあればローカル上でも動作するのでAccessにも埋め込めるはず・・・ということで実際に試してみることにしました。

今回のテストで実装さえたい機能は、以下のようなもの
・AccessのフォームにGoogleMapsAPIを埋め込む(ActiveX:Microsoft Web Browser使用)
・Accessテーブルに登録してある位置データをGoogleMapsAPI上にアイコン表示
・同データをAccessフォームにリスト表示(サブフォームにて)
・サブフォームのデータ選択時に、GoogleMapsAPI上の該当アイコンの色を変更する
・GoogleMapsAPIのアイコンをダブルクリックすると、該当する箇所の詳細フォームを別窓で開く

1.Web環境の準備
以下の環境でテスト
・データベース:Access2003
・Webサーバ:Apache
・Webプログラム言語:PHP

ApacheとPHPは別々に導入しても良いのですが、XAMPPにてまとめてインストールしました。
XAMPPには今回の実験では使用しないMySQL等も含まれていますが、別件でいろいろと使用機会がありますので。

XAMPP for Windows(日本語版): http://www.apachefriends.org/jp/xampp-windows.html

※XAMPPのインストールに関しては以下のサイトに丁寧な解説があります。

 金子邦彦研究室  http://www.kkaneko.com/rinkou/mysql/xamppinstall.html
 
2.データテーブルの準備
 テスト用サンプルとして、以下のような府中市の図書館のテーブルを作成しました。

 <仕様>
 ・テーブル名:M_Place
 ・フィールド構成
   PlaceCode:長整数型(PrimaryKey)・・・コード
   PlaceName:テキスト型・・・名称
   ZIP:テキスト型・・・郵便番号
   Address:テキスト型・・・住所
   TEL:テキスト型・・・電話番号
   Remarks:テキスト型・・・備考
   Lat:倍精度浮動小数点型・・・緯度
   Lng:倍精度浮動小数点型・・・経度

 図書館名称や住所、電話番号などの情報は府中市のHPから入手しました。
 緯度・経度は1件ずつ調べても良いのですが、せっかくなのでGoogleGeocodingAPIを利用して取得しました。
 以下にそのコードを記載します。

 緯度・経度の取得モジュール(関数:Get_LatLng)

'
'  GoogleMapAPIのジオコーディングサービスを利用して緯度・経度を取得
'
'  <引数>
'     myAddress:緯度・経度を取得したい地点の住所(○○駅、△△市役所など、名称でも取得出来る)
'     myLat    :緯度(参照渡し:戻り値)
'     myLng    :経度(参照渡し:戻り値)
'
Public Function Get_LatLng(ByVal myAddress As String, ByRef myLat As Double, ByRef myLng As Double) As Boolean

  Dim strURL As String, strURL_Base As String
  Dim objHttp As WinHttp.WinHttpRequest
  Dim resXML As String
  Dim strLocationS As String
  Dim strLocationE As String
  Dim strLocation As String
  Dim strLatS As String, strLatE As String
  Dim strLngS As String, strLngE As String
  Dim strLat As String, strLng As String
  Dim intS As Integer, intE As Integer
  Dim intLatS As Integer, intLatE As Integer
  Dim intLngS As Integer, intLngE As Integer
  Dim resArray
     
On Error GoTo Get_Html_Err
  
    Get_LatLng = False
  
    strLocationS = "<location>"
    strLocationE = "</location>"
    strLatS = "<lat>"
    strLatE = "</lat>"
    strLngS = "<lng>"
    strLngE = "</lng>"
  
    myLat = 0
    myLng = 0
    
    Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
           
    strURL_Base = "http://maps.google.com/maps/api/geocode/xml?sensor=false"
    strURL = strURL_Base & "&address=" & UrlEncode(myAddress)
    
    objHttp.Open "GET", strURL
    objHttp.Send
    If objHttp.Status <> 200 Then
       'エラー
    Else
       resXML = objHttp.ResponseText
       intS = InStr(resXML, strLocationS)
       intE = InStr(resXML, strLocationE)
       If (intS > 0 And intE > 0 And intE > intS) Then
          strLocation = Mid(resXML, intS + Len(strLocationS), intE - intS - Len(strLocationS))
          intLatS = InStr(strLocation, strLatS)
          intLatE = InStr(strLocation, strLatE)
          intLngS = InStr(strLocation, strLngS)
          intLngE = InStr(strLocation, strLngE)
          If intLatS > 0 And intLatE And intLatE > intLatS Then
             strLat = Mid(strLocation, intLatS + Len(strLatS), intLatE - (intLatS + Len(strLatS)))
          End If
          If intLngS > 0 And intLngE And intLngE > intLngS Then
             strLng = Mid(strLocation, intLngS + Len(strLngS), intLngE - (intLngS + Len(strLngS)))
          End If
          If IsNumeric(strLat) = True And IsNumeric(strLng) = True Then
             Get_LatLng = True
             myLat = CDbl(strLat)
             myLng = CDbl(strLng)
          End If
       End If
    End If

Get_Html_Exit:
   
    Set objHttp = Nothing
    Exit Function

Get_Html_Err:
    
    MsgBox Err.Number & ":" & Err.Description
    Resume Get_Html_Exit

End Function

'
'  文字列をURLエンコード
'
Public Function UrlEncode(ByVal strTxt As String) As String

Dim objScrCtl As Object

   Set objScrCtl = CreateObject("ScriptControl")

   objScrCtl.Language = "Jscript"
   UrlEncode = objScrCtl.CodeObject.encodeURIComponent(strTxt)

   Set objScrCtl = Nothing

End Function

※上記関数ではWinHTTPを利用してHTTP通信していますので、「ツール」→「参照設定」にて「Microsoft WinHTTP Services」にチェックを入れる必要があります(下画像参照)。

下の例ではフォーム上のコマンドボタン(Cmd_GetLatLng)クリック時に上記関数を使用して、テーブル「M_Place」の緯度・経度情報を更新

Private Sub Cmd_GetLatLng_Click()

  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim dblLat As Double
  Dim dblLng As Double
  
  Set db = CurrentDb
  
  strSQL = "SELECT * FROM M_Place"
  
  Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
  
  Do Until rs.EOF
     If Get_LatLng(rs!Address & " 府中市立" & rs!PlaceName, dblLat, dblLng) = True Then
        Debug.Print rs!PlaceName & ":" & rs!Address & ">>" & dblLat & "," & dblLng & "  " & rs!Lat & "," & rs!Lng

        rs.Edit
           rs!Lat = dblLat
           rs!Lng = dblLng
        rs.Update
     Else
        Debug.Print "error:" & rs!PlaceName
     End If
     rs.MoveNext
  Loop

  Set rs = Nothing
  Set db = Nothing
  
End Sub

Google Geocoding APIでは、必ずしも正確な緯度・経度を取得出来るとは限りません。
今回の府中市内の図書館のケースでも、住所が番地までしかないせいか(号がない)、取得位置にズレが生じました。次に住所+図書館名で試してもズレる箇所がありましたが、図書館の名称の頭に「府中市立」を付加したところ上手くいきました(上記コード)。

なおGoogle Geocoding APIの利用は1日あたり2,500件までに制限されているようなので、大量のデータを扱う場合には注意が必要です(有料サービスのGoogle Maps API Premierを利用すれば1日あたり100,000件までリクエスト可能とのことですが・・・)。
https://developers.google.com/maps/documentation/geocoding/?hl=ja

次回は、Accessテーブルの内容をPHPにてWeb出力するテストです。

コメントはまだありません。

    コメントフォーム

    post date*

     日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)

    トラックバック(1件)

    1. […] 今回、接続・出力対象とするのは前回作成した府中市の図書館情報テーブル「M_Place」です(当テーブルは「C:\Users\ひつじかい\Documents\GoogleMapsAPI埋め込みテスト.mdb」に収納とみなします […]

    トラックバックURL: