Use VBA to Map an Outlook Contact's Address

Last reviewed on January 29, 2014

Applies to Microsoft Outlook 2010, Outlook 2007, Outlook 2003.

While this macro isn't going to be particularly useful to most of us, since Outlook's MapIt button works and in some versions, can be reprogrammed to use another map service, you can use VBA if you want a second map service. Jerry wanted to use Zillow but he uses Outlook 2003 and Outlook 2003's map service can't be reprogrammed...

In this example, I'm using Zillow. Although Zillow seems to accept anything Outlook throws at them (%20 for spaces, + as word separators, no separators), their default spacer is a dash, so I'm using a function to replace spaces in the address with a dash. It makes a prettier URL too. :)

I'm constructing the address from the individual address fields but you could simply use strAddress = oContact.BusinessAddress or strAddress = oContact.HomeAddress.

This macro may work in Outlook 2002 and Outlook 2000; however I did not test it in those versions. It was tested in Outlook 2003 and up.

Map an Address Macro

Press Alt+F11 to open the VBA editor and paste the code into ThisOutlookSession. Customize the toolbar, ribbon, or QAT, by adding the macro to a button in the main Outlook window. Select the Contact and run the macro.


 
Sub MapAddress()
  
  Dim strURL As String
  Dim oApp As Object
  Dim strAddress As String

  Set oApp = CreateObject("InternetExplorer.Application")

If TypeName(ActiveExplorer.Selection.Item(1)) = "ContactItem" Then
 Set oContact = ActiveExplorer.Selection.Item(1)


strAddress = oContact.BusinessAddressStreet & "-" & oContact.BusinessAddressCity & "-" & oContact.BusinessAddressState

ReplaceSpaces strAddress
strURL = "http://www.zillow.com/homes/" & strAddress


oApp.navigate (strURL)
oApp.Visible = True

'wait for page to load before passing the web URL
Do While oApp.Busy
  DoEvents
Loop
 End If


Set oApp = Nothing
End Sub



Private Sub ReplaceSpaces(strAddress As String)
  strAddress = Replace(strAddress, " ", "-")
End Sub

For google maps, use this url:

strURL = "https://maps.google.com/maps?f=q&source=s_q&hl=en&geocode=&q=" & strAddress

Map a Meeting Location

Use this macro to map an address in a meeting or appointment's Location field.

This macro will work with either selected or opened appointments. You'll need the GetCurrentItem function to use it.

If you need to use a location in the appointment body, use regex to capture the address.

Sub MapAddress()
   
  Dim strURL As String
  Dim oApp As Object
  Dim strAddress As String

  Set oApp = CreateObject("InternetExplorer.Application")
 
 Set oAppt = GetCurrentItem()
 
strAddress = oAppt.Location
 
ReplaceSpaces strAddress
strURL = "https://maps.google.com/maps?f=q&source=s_q&hl=en&geocode=&q=" & strAddress
 
 
oApp.navigate (strURL)
oApp.Visible = True
 
'wait for page to load before passing the web URL
Do While oApp.Busy
  DoEvents
Loop


Set oApp = Nothing
End Sub
 

Private Sub ReplaceSpaces(strAddress As String)
  strAddress = Replace(strAddress, " ", "-")
End Sub

Using Firefox or Chrome Browser

If you want to use a different browser, you need to use the shell command to load the browser then pass the url to it. The shell command will look like this, with the full path to the browser. You need a space between the path to the browser and the url.

Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " " & strURL), vbNormalFocus

The path in my examples is for 64-bit Windows. If you use 32-bit Windows, the path will be C:\Program Files\Google\Chrome\Application\chrome.exe


Sub MapAddress()
  
  Dim strURL As String
  Dim strAddress As String

If TypeName(ActiveExplorer.Selection.Item(1)) = "ContactItem" Then
 Set oContact = ActiveExplorer.Selection.Item(1)


strAddress = oContact.BusinessAddressStreet & "-" & oContact.BusinessAddressCity & "-" & oContact.BusinessAddressState

ReplaceSpaces strAddress
strURL = "http://www.zillow.com/homes/" & strAddress

'Shell ("C:\Program Files (x86)\Mozilla Firefox\firefox.exe" & " " & strURL), vbNormalFocus
Shell ("C:\Program Files (x86)\Google\Chrome\Application\chrome.exe" & " " & strURL), vbNormalFocus

End If

End Sub


Private Sub ReplaceSpaces(strAddress As String)
  strAddress = Replace(strAddress, " ", "-")
End Sub



Written by

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Please post long or more complicated questions at Outlookforums.

4 responses to “Use VBA to Map a Contact's Address”

  1. Kiran

    Thanks, Really this code is very useful for me.

    I need to put all my contact on one google map.

    What can I do??

  2. Haik

    Hello Diane, I would like to have a macro in Outlook (when I make an appointment) which extracts the traveldistance (and driving time) from google maps.
    How do I do that?

Leave a Reply

If the Post Coment button disappears, press your Tab key.