[AccessD] Mappoint - Virtual Earth - and Access Db

Thu Sep 28 21:33:49 CDT 2006

For those of you wanting to footle around with Access and MS Virtual Earth
Here is some sample code, it also dumps the html code to an html file
By  clicking  on map you  display Lat/Long position of cursor

Option Compare Database
Option Explicit


Function testVirtualEarthMap()
'------------------
'display Virtual Earth at a fixed LatLong
' then  click on map to display Lat/Long position of cursor
'see these for info:
'http://dev.live.com/virtualearth/sdk/
'http://www.ftponline.com/special/web20/pvarholasp/default.aspx

Dim objExplorer As Object
Dim objDocument As Object
Dim strHTML As String

Set objExplorer = CreateObject("InternetExplorer.Application")

objExplorer.Navigate "about:blank"
objExplorer.Toolbar = 1 ' 0= off
objExplorer.StatusBar = 1 '0 =off
objExplorer.Width = 800
objExplorer.Height = 870
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1

Do While (objExplorer.Busy)
Loop


Set objDocument = objExplorer.Document
objDocument.Open
'create html string and dump to a test file
 strHTML = ""
 strHTML = strHTML & createhtml

WriteFile "c:\gis\test.html", strHTML

'objDocument.Writeln strHTML
objDocument.Write strHTML
objExplorer.Refresh ' ??This has to be done because of 
http://local.live.com/veapi.ashx
'objDocument.Close 'stall here
Do While (objExplorer.Busy)
Loop
'MsgBox "finished"
'Set objExplorer = Nothing
'Set objDocument = Nothing

End Function

Private Sub WriteFile(ByVal sFileName As String, ByVal sContents As String)
' Dump XML or html String to File for debugging
    Dim fhFile As Integer
    fhFile = FreeFile
   ' Debug.Print "Length of string=" & Len(sContents)
    Open sFileName For Output As #fhFile
    Print #fhFile, sContents;
    Close #fhFile
    Debug.Print "Out File" & sFileName
End Sub

Function createhtml() As String

Dim strHTML As String
 strHTML = ""
 strHTML = strHTML & "<html><head><title>Virtual Earth Map</title></head>"
  strHTML = strHTML & "<meta http-equiv=""Content-Type"" 
content=""text/html; charset=utf-8"">"
'When your page has referenced the map control, set up the call to 
display a default map by completing a LoadMap ( ) method call:
 strHTML = strHTML & vbCrLf & "<script 
src='http://dev.virtualearth.net/mapcontrol/v3/mapcontrol.js'></script> "
'  strHTML = strHTML & vbCrLf & "<script type='text/javascript' 
src='http://local.live.com/veapi.ashx'></script>"
 strHTML = strHTML & vbCrLf & "<script language=""javascript"" 
type=""text/javascript"">"
  

'  strhtml = strhtml & vbCrLf & "<!-- "
 strHTML = strHTML & vbCrLf & "     var map=null;"
 
 strHTML = strHTML & vbCrLf & " function ShowLatLon(e)"
 strHTML = strHTML & vbCrLf & "        {"
 strHTML = strHTML & vbCrLf & "alert('Latitude = ' + 
e.view.LatLong.Latitude + 'Longitude = ' + e.view.LatLong.Longitude);"
 strHTML = strHTML & vbCrLf & "       }"
 strHTML = strHTML & vbCrLf & "  function GetMap()"
 strHTML = strHTML & vbCrLf & " { "
 strHTML = strHTML & vbCrLf & "         map = new VEMap(""myMap"");"
 strHTML = strHTML & vbCrLf & "map.onLoadMap = function(){ alert('The 
map has loaded.') };"

 strHTML = strHTML & vbCrLf & "         map.LoadMap(new VELatLong(48.51, 
-123.36), 10 ,""h"" ,false);"
 strHTML = strHTML & vbCrLf & "    map.AttachEvent(""onclick"", 
ShowLatLon);"
 strHTML = strHTML & vbCrLf & " }"
 strHTML = strHTML & vbCrLf & "</script>"
' strhtml = strhtml & vbCrLf & "// -->"
'Last, you display the map:

 strHTML = strHTML & vbCrLf & "<body onload='GetMap();'>"
 strHTML = strHTML & vbCrLf & "<div id='myMap' style='position:relative; 
width:600px; height:600px;'></div>"
 strHTML = strHTML & vbCrLf & "<td> right or left click map for latitude 
longitude position </td>"
 strHTML = strHTML & vbCrLf & "</body>"
 strHTML = strHTML & vbCrLf & "</html>"
WriteFile "c:\gis\test.html", strHTML
createhtml = strHTML
End Function


-- 
Marty Connelly
Victoria, B.C.
Canada