PDA

View Full Version : Getting Distances



cmarquez
10-13-2006, 10:08 AM
Hello I want to know how I can do a loop process or something to calculate at the same time 100 directions or more extracting the data from excel, I made the calculation example in the tutorial and I have been Trying to make this loop process but I can't make it works.

Eric Frost
10-13-2006, 11:18 AM
Which tutorial? Post the code you have written so far and I will check it out, better yet send me your spreadsheet or post it as an attachment.

Eric

cmarquez
10-13-2006, 12:04 PM
Here you have the code, I know it should be an easy procedure, but if I loop the process The map appear all time, and is a really waist of time, and what I need is to insert even more than 100 point a, and point b, an determinate the distances betwen them.

Eric Frost
10-13-2006, 12:11 PM
Just put the

CreateObject("MapPoint.Application")

outside of the loop? I'm not sure I understand the problem.

For me the code did fail at the line --

objRoute.Waypoints.Add objMap.FindResults(szZip3).Item(1)

Eric

cmarquez
10-13-2006, 12:44 PM
This is like the sheet that I need to fill, and the code I have, my problem is that I don't know how to automate this code and find the hole directions just by clicking the buttom, because when I tried to do it it give me a message that If I want to keep changes in the map, but for every input that I make.

Eric Frost
10-14-2006, 08:09 AM
Great. I can help you with this.

First -- What version(s) of MapPoint do you have installed? The country lists Germany and I am finding those postcodes in Germany, but early in the code you have a line:

Set oApp = CreateObject("MapPoint.Application.NA.11")

This is for MapPoint 2004 North America.

If you want to specify and start MapPoint 2004 Europe, change the line to:

Set oApp = CreateObject("MapPoint.Application.EU.11")

For MapPoint 2006 Europe, the line should be:

Set oApp = CreateObject("MapPoint.Application.EU.13")


Note also that if you only have one version of MapPoint installed you can just do this:

Set oApp = CreateObject("MapPoint.Application")

And it will find and open whatever version of MapPoint you have installed.

Eric

cmarquez
10-16-2006, 03:30 AM
Ok, thanks it works good, but

Now I made this loop process and still give me a compile error, and when I give more than 20 directions it gets lock, and allways show me a message "want to save changes to the map" that it's what I think that lock me the aplication

Here is the code.


Dim oApp As MapPoint.Application
Private Sub CommandButton1_Click()
Set oApp = CreateObject("MapPoint.Application")
oApp.Visible = False
Set objMap = oApp.NewMap
Set objRoute = objMap.ActiveRoute
Dim i As Integer
Dim j As Integer
Dim k As Integer


i = 1
j = 1
k = 3

Do

Codei = Worksheets("Sheet1").Cells(k, 1)
Codej = Worksheets("Sheet1").Cells(k, 2)

'Add route stops and calculate the route
objRoute.Waypoints.Add objMap.FindResults(Codei).Item(1)
objRoute.Waypoints.Add objMap.FindResults(Codej).Item(1)
objRoute.Calculate

Worksheets("Sheet1").Cells(k, 3) = objRoute.Distance
i = 1 + 1
j = j + 1
k = k + 1

Loop While i <= 100

End Sub

Eric Frost
10-16-2006, 09:16 AM
What are i, j, and k? That is confusing to me.

Also, what version of MapPoint are you using? I assume MapPoint Europe, but is it MapPoint 2004 or MapPoint 2006 ? That might help just in debugging when it does not find a postal code which I assume will happen sometimes and the code will probably still break..

I have re-written the code, the bill is in the mail :-) I switched to FindAddressResults because I was having trouble with FindResults, sometimes it would come back with a location in Italy. FindAddressResults let's you specify Germany, right now it is hard-coded (only works) for Germany.

Also, I added a objRoute.Clear statement.

Hope this helps and does what you want it to do.

Eric




Dim oApp As MapPoint.Application
Private Sub CommandButton1_Click()
Set oApp = CreateObject("MapPoint.Application.EU")
oApp.Visible = True
Set objMap = oApp.NewMap
Set objRoute = objMap.ActiveRoute
Dim nCurrentRow As Integer
nCurrentRow = 2
Dim Code1, Code2 As String
Dim objFindResults As MapPoint.FindResults
Do While Len(Worksheets("Sheet1").Cells(nCurrentRow, 1)) <> 0
Code1 = Worksheets("Sheet1").Cells(nCurrentRow, 2)
Code2 = Worksheets("Sheet1").Cells(nCurrentRow, 4)
Set objFindResults = objMap.FindAddressResults(, , , , Code1, geoCountryGermany)
'MsgBox "The first item in the find list is: " + objFindResults.Item(1).Name
objRoute.Waypoints.Add objFindResults(1)

Set objFindResults = objMap.FindAddressResults(, , , , Code2, geoCountryGermany)
objRoute.Waypoints.Add objFindResults(1)

objRoute.Calculate
'MsgBox "The route distance is: " + CStr(objRoute.Distance)
Worksheets("Sheet1").Cells(nCurrentRow, 5) = objRoute.Distance
objRoute.Clear
nCurrentRow = nCurrentRow + 1
Loop
End Sub

Eric Frost
10-16-2006, 09:22 AM
In MapPoint 2006 it got down to row 25 before it found a postal code it could not find.. you could either figure out which postcodes it does not find and remove or replace them on the spreadsheet or modify the code so it does not stop when it hits these.

hope this helps!

Eric

cmarquez
10-17-2006, 02:20 AM
well I'm using the 2004 Europe Version, I, j, k are variable to make the loop process, but I think is better the way you put it, but I can't make your code works even just with germany codes

cmarquez
10-17-2006, 05:50 AM
It works really good, I made some changes to be able to work with other countries and also I added this to end the mappoint

oApp.ActiveMap.Saved = True
oApp.Quit
Set oApp = Nothing

But how I can do to have more than 25 rows??? because it works really good until row 25 but after that it show me a bug

Thanks

cmarquez
10-17-2006, 08:21 AM
Well this is the final code I have, the only thing is that I can't make the process for more than 25 row, do you know how I can do it?

The code

Dim oApp As MapPoint.Application
Private Sub CommandButton1_Click()
Set oApp = CreateObject("MapPoint.Application.EU")
oApp.Visible = False
Set objMap = oApp.NewMap
Set objRoute = objMap.ActiveRoute
Dim nCurrentRow As Integer
nCurrentRow = 3

Dim Code1, Code2 As String
Dim objFindResults As MapPoint.FindResults


Do While Len(Worksheets("Sheet1").Cells(nCurrentRow, 6)) <> 0


Code1 = Worksheets("Sheet1").Cells(nCurrentRow, 3)
Code2 = Worksheets("Sheet1").Cells(nCurrentRow, 6)

On Error Resume Next

If Code1 = ", " Then Exit Do


Set objFindResults = objMap.FindResults(Code1)
objRoute.Waypoints.Add objFindResults(1)
Set objFindResults = objMap.FindResults(Code2)
objRoute.Waypoints.Add objFindResults(1)



objRoute.Calculate
On Error GoTo 0
Worksheets("Sheet1").Cells(nCurrentRow, 7) = objRoute.Distance
Worksheets("Sheet1").Cells(nCurrentRow, 8) = CStr(objRoute.TripTime / geoOneMinute)

objRoute.Clear
nCurrentRow = nCurrentRow + 1



Loop

oApp.ActiveMap.Saved = True
oApp.Quit
Set oApp = Nothing



End Sub

cmarquez
10-17-2006, 09:32 AM
It was just a wrong zip code, but this code works really good, thanks a lot for your help

Eric Frost
10-17-2006, 09:34 AM
Terrific, I'm glad you got it to work and I like your modifications.

Please tell other people about this forum and link to it :bluecool:

Check on row 25 (or the row above or below) and put those postal codes directly into MapPoint manually, one of them must not be found i.e. MapPoint cannot find one of them.

Do either or both of the following
1. find a nearby postal code and fix it on the spreadsheet to be a zip code MapPoint can find..
2. place something in to code so that when it doesn't find a postal code it skips that line. I don't have the MapPoint Help File in front of me but it would be something like If objFindResults.Count = 0 then [SKIP TO NEXT ROW]. Maybe there is no objFindResults.Count property or anything like but, but that would be the logic anyway.

best,
Eric