[AccessD] More MapPoint Help If Possible

Do these addresses change daily?  If not why not precalc the distances and
store them?

John W. Colby
www.ColbyConsulting.com 

Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
paul.hartland at fsmail.net
Sent: Thursday, June 09, 2005 5:06 AM
To: accessd
Subject: [AccessD] More MapPoint Help If Possible


To all,

I have the following code which sends a Client postcode and around 475
employee postcodes to MapPoint and returns the Mileage, however this takes
around 16 minutes to complete which is far too long for our needs, can
anyone see a way of speeding this up we really need this procedure to be as
fast as possible.

Private Sub FlyMap_Click()
On Error Resume Next
    Dim rsClient As ADODB.Recordset
    Dim rsEmp As ADODB.Recordset
    Dim oMap As MapPoint.Map
    Dim oLoc1 As MapPoint.Location
    Dim oLoc2 As MapPoint.Location
    Dim strCPC As String
    
    Dim dtStart As Date
    Dim dtFinish As Date
    
    Set rsClient = New ADODB.Recordset
    rsClient.Open ("SELECT InvPostCode FROM tblClaires"), OpenDataConn,
adOpenDynamic, adLockReadOnly
    strCPC = rsClient!InvPostCode
    rsClient.Close
    Set rsClient = Nothing
    
    Set rsEmp = New ADODB.Recordset
    rsEmp.Open ("SELECT PayrollNo, Postcode, DistFromClient FROM
tblMidlands"), OpenDataConn, adOpenDynamic, adLockOptimistic
    
    Set oMap = CreateObject("MapPoint.Application").ActiveMap
    oMap.Parent.PaneState = geoPaneRoutePlanner
    
    With oMap.ActiveRoute
        rsEmp.MoveFirst
        dtStart = Format(Time(), "HH:MM:SS")
        
        Screen.MousePointer = vbHourglass
        
        Do Until (rsEmp.EOF)
            If (IsNull(rsEmp.Fields("Postcode")) = False Or
rsEmp.Fields("Postcode") <> "") Then
                Set oLoc1 = oMap.FindResults(strCPC)(1)
                Set oLoc2 = oMap.FindResults(rsEmp.Fields("Postcode"))(1)
                If (oLoc1 Is Nothing Or oLoc2 Is Nothing) Then
                    ' **** No Results Returned ****
                Else
                    ' **** Results Returned So Calculate Distance Etc ****
                    .Waypoints.Add oLoc1, "Start"
                    .Waypoints.Add oLoc2, "End"
                    .Calculate
                    If (.IsCalculated = True) Then
                        rsEmp.Fields("DistFromClient") = Format(.Distance,
"00.00")
                        rsEmp.Update
                    End If
                End If
            End If
            rsEmp.MoveNext
            .Clear
        Loop
        
        Screen.MousePointer = vbDefault
    End With
    rsEmp.Close
    Set rsEmp = Nothing
    oMap.Saved = True
    Set oMap = Nothing
    
    dtFinish = Format(Time(), "HH:MM:SS")
    MsgBox "Finished : " & Format(dtFinish - dtStart, "HH:MM:SS") End Sub


Thanks in advance for any help and/or code samples

Paul Hartland

-- 

Whatever you Wanadoo:
http://www.wanadoo.co.uk/time/

This email has been checked for most known viruses - find out more at:
http://www.wanadoo.co.uk/help/id/7098.htm
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com