Use VBA to Map an Outlook Contact's Address

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

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

Related Posts:

1. 

   Open a webpage when a Task reminder fires
2. 

   Assign an Email Account to an Outlook Contact
3. How to replicate Outlook's New letter to Contact feature using a custo

   Create a Letter to a Contact using VBA
4. 

   How to Change the Mapping Service used by Outlook's Map Link