‘Alan dot Kaplan at VA dot Gov 3/12/2009
‘This script opens address of current Outlook contact in Google Maps.
Dim objOutlook, objInspector
Dim objExplorer, objNameSpace, objItem
Dim oIE
Dim strAddress, strURL
‘Set reference to Outlook item
Set objOutlook = CreateObject(“Outlook.Application”)
Set objNameSpace = objOutlook.GetNamespace(“MAPI”)
Set objInspector = objOutlook.ActiveInspector
Set objExplorer = objOutlook.ActiveExplorer
If instr(objExplorer.CurrentFolder,”Contacts”) = 0 Then
MsgBox “Contacts folder not open, quitting”,vbCritical + vbOKOnly,”Error”
WScript.Quit
End If
On Error Resume Next
‘Get address from Outlook, and reformat
Set objItem = objInspector.CurrentItem
if objInspector.CurrentItem.Class <> 40 Then
MsgBox “A contact is not not open, quitting”,vbCritical + vbOKOnly,”Open Contact Detail”
WScript.Quit
End If
‘check length
strAddress = objItem.MailingAddress
If Len(strAddress) < 5 Then
MsgBox “No address info in contact, quitting”,vbCritical + vbOKOnly,”No Address”
WScript.Quit
End If
strAddress = Replace(strAddress,VbCrLf,”, “)
‘Now do query and web stuff
strAddress = Replace(strAddress,Space(1),”+”)
strAddress = Replace(strAddress,”,”,”%2C”)
‘Add that to Google maps query
strURL = “http://maps.google.com/maps?q=” & strAddress
‘open in IE
Set oIE = CreateObject(“InternetExplorer.Application”)
oIE.Navigate strURL
oIE.Visible = True