Discussion:
Developing with Access VBA and MapPoint
(too old to reply)
e***@mp2kmag.com
2013-09-12 18:15:52 UTC
Permalink
Here's a couple of new articles --

Access VBA Programming
- Part I - Geocoding with MapPoint
- Part II - Calculating a Distance Matrix

http://www.mapforums.com/access-vba-programming-part-i-geocoding-mappoint-28228.html
http://www.mapforums.com/access-vba-programming-part-ii-calculating-distance-matrix-28235.html

This Sub one is for geocoding, see below for another one on getting driving distances --

Sub Geocode()
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


Sub CalculateDistances()
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
Pramod J
2021-08-27 07:28:46 UTC
Permalink
Post by e***@mp2kmag.com
Here's a couple of new articles --
Access VBA Programming
- Part I - Geocoding with MapPoint
- Part II - Calculating a Distance Matrix
http://www.mapforums.com/access-vba-programming-part-i-geocoding-mappoint-28228.html
http://www.mapforums.com/access-vba-programming-part-ii-calculating-distance-matrix-28235.html
This Sub one is for geocoding, see below for another one on getting driving distances --
Sub Geocode()
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
Sub CalculateDistances()
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
Hi Eric Frost,

I can help you in this please message me.

Thanks
Auric__
2021-08-27 17:17:03 UTC
Permalink
[snip]
Post by Pramod J
Hi Eric Frost,
I can help you in this please message me.
Thanks
Eric posted 8 years ago. He's probably not still waiting for help or
whatever. Pay attention to the posting date.

Fucking Google Groupies.
--
I think it's hard winning a war with words, gentlemen.
u***@domain.invalid
2021-10-07 17:26:55 UTC
Permalink
Post by Auric__
[snip]
Post by Pramod J
Hi Eric Frost,
I can help you in this please message me.
Thanks
Eric posted 8 years ago. He's probably not still waiting for help or
whatever. Pay attention to the posting date.
Fucking Google Groupies.
Maybe its almost a good thing they are nuking Google Groups access to
specific newsgroups but then again not good that the archives are lost.

https://www.theregister.com/2021/06/01/google_usenet/

Loading...