John W. Colby
jwcolby at colbyconsulting.com
Fri Jun 3 09:09:26 CDT 2005
Paul,
This code (see below this message) is a class clsLocation that I developed
to hold information about a location. There is only one reference that is
specific to my code which I will get to in a minute. As you know I prefer
to use classes if the code is going to be more than trivial.
This class holds all the information and methods that I thought would be
useful for a single location. I populate it initially from a function that
opens a recordset of addresses I want to map. Each class instance holds
data about a single location.
I pass in the address information. I also pass in a "name" value in order
to allow naming the pushpin etc. I pass in a "type" integer just so that I
can sort the locations. For example I am mapping contracts and people to
call about the contracts. For this purpose, in my application every
contract address is a "type" of 1 and people are "type" of 2. Type
information is obviously specific to the application and can just be zero if
you don't need to "group" the locations into sets. All of the data passed
in are stored in private variables in the class.
Function init(strName As String, lintType As Integer, lstrAddr1 As String,
lstrCity As String, _
lstrState As String, lstrPostalCode As String, _
Optional lstrCountry As String = "USA")
The one piece of code specific to my MapPoint framework (which is under
development and which this is pulled from) is the line in init:
Set mcolFindAddrRes = cMPtApp.ActiveMap.FindAddressResults(mstrAddr1,
mstrCity, , lstrState, mstrPostalCode, mstrCountry)
cMPTApp is a function that returns a pointer to the open MapPoint
application. This corresponds to a single global variable pointer to the
MapPoint Application, dimensioned private to the basInitMapPoint module,
initialized in an InitMapPoint() method, and then a function cMPtApp()
returns the pointer to that private global variable.
This class then can provide properties to get back the data originally
supplied (if you want that) such as the zipcode and so forth. It also has
built into the class a call to "find" the address - in Init():
Set mcolFindAddrRes = cMPtApp.ActiveMap.FindAddressResults(mstrAddr1,
mstrCity, , lstrState, mstrPostalCode, mstrCountry)
The ActiveMap.FindAddressResults returns a collection of location objects
that are candidates for the address you passed in. What happens is that if
the address does not resolve to a single address then MapPoint will return 0
to N possible locations that MIGHT be what you are looking for.
mcolFindAddrRes by the way is a collection in my class which holds all of
the location objects returned by ActiveMap.FindAddressResults. You may or
may not even want this kept around after the Init() finishes. It does allow
you to map all the "possible locations" if you want to see them for some
reason.
Having asked MapPoint to find the address, the class then checks to see if
exactly one location was returned in the collection. First of all, I have
seen issues where the call to the FindAddressResults returned an automation
error so I check for errors first. I get the feeling that the automation
errors were caused by operator error (me) but it caused me to put in the
check anyway.
If no error, then I check for just one location in the results collection:
If mcolFindAddrRes.Count = 1 Then
Set mLoc = mcolFindAddrRes.Item(1)
mblnOneLoc = True
Else
mblnOneLoc = False
End If
If there is just one location returned, I grab that location object and
store it in mLoc. Mloc is the key to this class since it is the actual
location object for an address that MapPoint understands. Having this
location object allows us to create a push pin, get distances to other
locations etc.
So by the time the Init() returns you either have a location object and a
Boolean saying you have just one, or you do not have a location object and
the Boolean says that you didn't find just one location for the address
supplied. What I have found is that MapPoint is very sensitive to things
like "PO Box XXX" or "Suite 44" in the address1 field and fails to map to a
single location for such addresses.
The class then provides other functions useful to a location such as the
MapIt() method which places a pushpin into the map and stores the pushpin
object. I do not automatically create push pins since some applications
don't need them. The class also provides two distance methods which will
return the distance between this location and another location object passed
in.
Obviously error handling is still under development. I have only been doing
this for two days, and that time includes a bunch of dev on the MapPoint
framework itself - which this class is a part of.
As an example of using this class, I am adding a couple of fields in my
application's Agency table to allow me to iterate through all the agencies
and try and map their address. I want to do this up front, then not pull an
agency for mapping if I have already found it not mappable. The code to do
that is immediately below. As you can see, once the Location class is
built, using it is trivial and allows you to do a lot of stuff pretty
quickly.
Anyway, this should allow for a discussion of possibilities with MapPoint.
By having a class for the location, you can wrap any and all code and
properties that you think a location needs into a wrapper and use it quickly
and easily.
'****************************************
'Class usage code - map all agencies that are mappable
'****************************************
Function TestAgencyMapAddr()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim lclsLocation As clsLocation
Const cintAgency = 1
MPtInit CurrentProject.Connection
With cMPtApp
.Top = 0
.Left = 0
.WindowState = geoWindowStateMaximize
.Visible = True
End With
strSQL = "SELECT * " & _
"FROM qSelAgencyMapAddr " & _
"WHERE AG_DteMappable IS NULL"
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL)
With rst
While Not .EOF
Set lclsLocation = New clsLocation
lclsLocation.init !Name, cintAgency, !Addr1, !City, !State, !Zip
If lclsLocation.pOneLoc Then
lclsLocation.mMapIt
End If
.MoveNext
DoEvents
Wend
End With
End Function
'****************************************
'The class code
'****************************************
Option Compare Database
Option Explicit
Private mintType As Integer 'The type of location. Defined
by application. For example, 1 = business, 2 = personal etc.
Private mstrName As String 'The location name - company
name, person name etc.
Private mstrAddr1 As String 'The address fields needed to
find a location
Private mstrCity As String
Private mstrState As String
Private mstrPostalCode As String
Private mstrCountry As String
Private mblnOneLoc As Boolean 'True if more than one location
matches the address info
Private mblnAutomationErr As Boolean
Private mcolFindAddrRes As MapPoint.FindResults 'The collection of possible
locations if more than one
Private mLoc As MapPoint.Location 'The specific location object if
narrowed down to just one
Private mPushPin As MapPoint.Pushpin 'The pushpin associated with the
location
Private Sub Class_Terminate()
Set mLoc = Nothing
Set mcolFindAddrRes = Nothing
Set mPushPin = Nothing
End Sub
Function init(strName As String, lintType As Integer, lstrAddr1 As String,
lstrCity As String, _
lstrState As String, lstrPostalCode As String, _
Optional lstrCountry As String = "USA")
On Error GoTo Err_init
mstrName = strName
mintType = lintType
mstrAddr1 = lstrAddr1
mstrCity = lstrCity
mstrState = lstrState
mstrPostalCode = lstrPostalCode
mstrCountry = lstrCountry
On Error Resume Next
Set mcolFindAddrRes = cMPtApp.ActiveMap.FindAddressResults(mstrAddr1,
mstrCity, , lstrState, mstrPostalCode, mstrCountry)
If Err = 0 Then
If mcolFindAddrRes.Count = 1 Then
Set mLoc = mcolFindAddrRes.Item(1)
mblnOneLoc = True
Else
mblnOneLoc = False
End If
Else
mblnOneLoc = False
mblnAutomationErr = True
End If
Exit_init:
Exit Function
Err_init:
MsgBox Err.Description, , "Error in Function clsLocation.init"
Resume Exit_init
Resume 0 '.FOR TROUBLESHOOTING
End Function
Property Get pOneLoc() As Boolean
pOneLoc = mblnOneLoc
End PropertyProperty Get colFindAddrRes() As MapPoint.FindResults
Set colFindAddrRes = mcolFindAddrRes
End Property
Property Get pLoc() As MapPoint.Location
Set pLoc = mLoc
End Property
Property Get pPushPin() As MapPoint.Pushpin
Set pPushPin = mPushPin
End Property
Property Get pName() As String
pName = mstrName
End Property
Function mMapIt() As Boolean
On Error GoTo Err_mMapIt
Dim objLoc As MapPoint.Location
If mblnAutomationErr Then
Debug.Print mstrName & " Could not be looked up"
Else
If mblnOneLoc Then
Set mPushPin = cMPtApp.ActiveMap.AddPushpin(mcolFindAddrRes(1),
mstrName)
mMapIt = True
Else
Debug.Print mcolFindAddrRes.Count & " locations found for " &
mstrName
End If
End If
' For Each objLoc In mcolFindAddrRes
' Set mPushPin = cMPtApp.ActiveMap.AddPushpin(objLoc, mstrName)
' Next objLoc
Exit_mMapIt:
Exit Function
Err_mMapIt:
MsgBox Err.Description, , "Error in Function clsLocation.mMapIt"
Resume Exit_mMapIt
Resume 0 '.FOR TROUBLESHOOTING
End Function
Public Function DistanceAsTheCrowFlies(oLoc2 As MapPoint.Location) As Double
If mblnOneLoc Then
DistanceAsTheCrowFlies = mLoc.DistanceTo(oLoc2)
Else
DistanceAsTheCrowFlies = 0
End If
End Function
Public Function DistanceAsTheCarDrives(oLoc2 As MapPoint.Location) As Double
On Error GoTo Err_DistanceAsTheCarDrives
With cMPt.cMPtMap
.ActiveRoute.Clear
.ActiveRoute.Waypoints.Add mLoc, "Start"
.ActiveRoute.Waypoints.Add oLoc2, "End"
.ActiveRoute.Calculate
DistanceAsTheCarDrives = .ActiveRoute.Distance
End With
Exit_DistanceAsTheCarDrives:
Exit Function
Err_DistanceAsTheCarDrives:
MsgBox Err.Description, , "Error in Function
clsFWMapPt.DistanceAsTheCarDrives"
Resume Exit_DistanceAsTheCarDrives
Resume 0 '.FOR TROUBLESHOOTING
End Function
John W. Colby
www.ColbyConsulting.com
Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/