Today I have been I'r'een mostly messing about with Map Point.
The following code (called with the GetDistance sub) will return the distance between 2 post codes. To use this code as is, you'll need to select 2 adjacent cells (i.e. A1 and B1), the distance will be put in the 3rd column along (i.e C1). Clearly you will need Map Point installed also. It’s late bound, but I have not tested the error and checking code should Map Point not be on the machine. I have version 2004 of Map Point and I didn’t have much joy in automating pervious version, but give it a try anyway!
Global gObjApp As Object '''Golbal deleration for the Map Point Object
Sub GetDistance()
Dim cell As Excel.Range
Dim i As Long
If gObjApp Is Nothing Then
OpenMapPointApp
If gObjApp Is Nothing Then ' check app was established ok
Exit Sub
Else: End If
Else: End If
For i = 1 To Selection.Rows.Count
Selection.Cells(i, 3) = GRD(Selection.Cells(i, 1), Selection.Cells(i, 2))
Next
If gObjApp Is Nothing Then
Else:
CloseMapPointApp
End If
End Sub
Sub OpenMapPointApp()
On Error GoTo LEH
Set gObjApp = CreateObject("MapPoint.Application")
gObjApp.Visible = False
'gObjApp.UserControl = True
Exit Sub
LEH:
MsgBox "Sorry Could not open a Map Point Application, bummer! - Ross" _
, vbOKOnly + vbCritical, "M.I.E Map Point thing"
End Sub
Sub CloseMapPointApp()
'''Change saved property to ture for the the active (and only) map,
'''stops any maessage getting displayed
gObjApp.ActiveMap.Saved = True
gObjApp.Quit
Set gObjApp = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Function : GetRouteDistance
' DateTime : 18/04/2006 16:04
' Author : rmclean
' Purpose : Gets the routed distacne between 2 way points using an already opened
' Map Point Object.
'---------------------------------------------------------------------------------------
Function GRD(sPCFrom As String, sPCTo As String)
On Error GoTo LEH
With gObjApp.ActiveMap.ActiveRoute
.Clear
.Waypoints.Add gObjApp.ActiveMap.FindAddressResults(PostalCode:=sPCFrom, Country:=0)(1)
.Waypoints.Add gObjApp.ActiveMap.FindAddressResults(PostalCode:=sPCTo, Country:=0)(1)
.Calculate
GRD = .Distance
End With
Exit Function
LEH:
'''There could be a few reasons for an erorr, proably could not
'''match the post code, I dont care that much, just need to return
''' a good anwser.
GRD = "Could Not Route"
End Function
I have used the LocaleID of the user's computer for the country value (...FindAddressResults(PostalCode:=sPCFrom, Country:=0)...) the full list is here: GeoCountry values
bon!
very good