Geocoding and Calculating Driving Distances with Access VBA and MapPoint

[EricFrost]

Here are some code examples for geographic calculations in an Access module using MapPoint that I recently put together.

These are probably the commonly performed operations (geocoding and getting driving distances) so I figured they'd be worth sharing.

This first one gets the Latitude Longitude for an address and writes the matching quality information back to an Access table --

Sub Geocode()
  'article at [URL unfurl="true"]http://www.mapforums.com/access-vba-programming-part-i-geocoding-mappoint-28228.html[/URL]
  Dim APP As MapPoint.Application
  Dim MAP As MapPoint.MAP
  Dim FAR As MapPoint.FindResults
  Dim LOC As MapPoint.Location
  
  Set APP = CreateObject("MapPoint.Application")
  APP.Visible = True
  Set MAP = APP.ActiveMap
  
  Dim rs As Recordset
  Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Al's Beef]")

  Do Until rs.EOF = True
    Set FAR = MAP.FindAddressResults(rs("Address"), rs("City"), , rs("State"), rs("Zip"))
    Set LOC = FAR(1)
    rs.Edit
    rs!MP_Latitude = LOC.Latitude
    rs!MP_Longitude = LOC.Logitude
    rs!MP_MatchedTo = GetGeoFieldType(LOC.Type)
    rs!MP_Quality = GetGeoQuality(FAR.ResultsQuality)
    rs!MP_Address = LOC.StreetAddress.Value
    rs.Update
    rs.MoveNext
  Loop
End Sub

This second one calculates driving distances between locations --

Sub CalculateDistances()
  'article at [URL unfurl="true"]http://www.mapforums.com/access-vba-programming-part-ii-calculating-distance-matrix-28235.html[/URL]
  Dim APP As MapPoint.Application
  Dim MAP As MapPoint.MAP
  Dim RTE As MapPoint.Route
  Dim LOC1, LOC2 As MapPoint.Location
  
  Set APP = CreateObject("MapPoint.Application")
  APP.Visible = True
  Set MAP = APP.ActiveMap
  Set RTE = MAP.ActiveRoute
  
  Dim rs1, rs2 As Recordset
  Set rs1 = CurrentDb.OpenRecordset("SELECT * FROM [Al's Beef]")
  Set rs2 = CurrentDb.OpenRecordset("SELECT * FROM [Al's Beef]")
  
  Dim sql As String
  sql = "CREATE TABLE AB_Distances (ID1 INTEGER, ID2 INTEGER, Distance Float)"
  CurrentDb.Execute sql

  Do Until rs1.EOF = True
    Set LOC1 = MAP.GetLocation(rs1("MP_Latitude"), rs1("MP_Longitude"))
    rs2.MoveFirst 'reset
    Do Until rs2.EOF = True
      If rs1("ID") <> rs2("ID") Then 'don't bother to calculate a store's distance to itself
        Set LOC2 = MAP.GetLocation(rs2("MP_Latitude"), rs2("MP_Longitude"))
        RTE.Waypoints.Add LOC1
        RTE.Waypoints.Add LOC2
        RTE.Calculate
        sql = "INSERT INTO AB_Distances (ID1, ID2, Distance) VALUES (" & rs1("ID") & ", " & rs2("ID") & ", " & RTE.Distance & ")"
        CurrentDb.Execute sql
      End If
      rs2.MoveNext
      RTE.Clear
    Loop
    rs1.MoveNext
  Loop
  MAP.Saved = True
  Debug.Print "finished"
End Sub