The mapping function in Outlook only works for contacts and a common request is to also get driving directions for appointments and meetings.
This guide provides a macro for this and will explain how you can customize this macro. The customizations are selecting a mapping service of your choice and setting your starting location.
The MapCalendarLocation macro will allow you to use a web based mapping service to pinpoint the location of a meeting on a map and to also get driving directions to that place. For this it will use the address as specified in the “Location” field of the meeting or appointment.
The macro contains 3 preconfigured mapping services namely;
Aside from selecting the mapping service to be used, you can also specify if you only want to pinpoint the location on the map or to also get driving directions to that location. In case of the last, you’ll also have to specify a starting location.
All these settings can be easily changed at the top part of the macro code.
Use the following instructions to configure the macro in Outlook;
- Download this code-file (
mapit4meetings.zip) or copy the code below.
- Open the VBA Editor (keyboard shortcut ALT+F11).
- Extract the zip-file and import the
mapit4meetings.basfile via File-> Import…
If you copied the code paste it into a new module.
- Optionally; customize the code to select a different mapping service, enable driving directions and to set a starting location.
- Sign your code so you won’t get any security prompts and the macro won’t get disabled.
- Add a button for easy access to the macro or press ALT+F8 and select the macro you want to execute.
Add a button to the Ribbon or the QAT to execute the MapCalendarLocation macro.
Using and customizing the macro
While the macro already works without needing to make any modifications to the code provided, you will have to modify the code if you want to change the mapping service that is being used or if you want to enable the route planner capabilities.
Instructions for the modifications needed are given at the top of the code. Read these carefully and do not edit anything below the “STOP EDITING” line.
As mentioned, the macro works based on the “Location” field of the Meeting or Appointment. So, in order for this macro to work, make sure that you’ve specified this field.
The location should be specified in the same format as you would normally use when directly using the respective website.
You can execute the macro either from an opened Meeting or Appointment item or directly from within the Calendar by selecting any Meeting or Appointment.
If you want to use starting locations which you’ve saved with the mapping service, set the DrivingDirections variable to “True” and adjust the FromString variable to;
FromString = ""
This will leave the field empty and allows you to select a saved address in the mapping service.
For instance, with Google Maps, the default is “Your location” and all you have to do is press the Search button. If the address is set in code, the search is automatic.
The following code is contained in the zip-file referenced in the Quick Install. You can use the code below for review or manual installation.
Public Sub MapCalendarLocation() '============================================================== ' Description: Outlook macro to get driving instructions ' to meeting locations. ' ' author : Robert Sparnaaij ' version: 1.0 ' website: https://www.howto-outlook.com/howto/mapit4meetings.htm '============================================================== '====================READ AND EDIT IF NEEDED============== 'Select your mapping service by setting the number MappingService = 1 ' 1 = Bing Maps ' 2 = Google Maps ' 3 = OpenStreetMap 'For this macro to work, it is important that you type 'the address in the query format required by the mapping 'service that you selected. 'This address has to be typed in the "Location" field of 'the appointment or meeting request. 'Select if you want driving directions. 'If you set this to True, you must also specify 'your starting location. DrivingDirections = False 'Specify your starting location 'Make sure you write your address between double quotes. 'Example: street = "My Street Name 12" addr_street = "" addr_city = "" addr_state = "" addr_zipcode = "" addr_country = "" '===================STOP EDITING========================== Dim FromString As String FromString = addr_street & ", " & addr_city & ", " & addr_state & ", " & addr_zipcode & ", " & addr_country Dim obj As Object Dim Appointment As Outlook.AppointmentItem Set obj = Application.ActiveWindow If TypeOf obj Is Outlook.Inspector Then Set obj = obj.CurrentItem Else Set obj = obj.Selection(1) End If If TypeOf obj Is Outlook.AppointmentItem Then Set Appointment = obj Dim LocationString As String LocationString = Appointment.Location If DrivingDirections = False Then Select Case MappingService Case 1 NavigationString = "https://bing.com/maps/?where1=" & URLEncode(LocationString, True) Case 2 NavigationString = "https://www.google.com/maps/search/?api=1&query=" & URLEncode(LocationString, True) Case 3 NavigationString = "https://www.openstreetmap.org/search?query=" & URLEncode(LocationString) Case Else MsgBox ("No valid mapping service selected.") End Select ElseIf DrivingDirections = True Then Select Case MappingService Case 1 NavigationString = "https://bing.com/maps/?rtp=adr." & _ URLEncode(FromString, True) & "~adr." & URLEncode(LocationString, True) Case 2 NavigationString = "https://www.google.com/maps/dir/?api=1&origin=" & _ URLEncode(FromString, True) & "&destination=" & URLEncode(LocationString, True) Case 3 NavigationString = "https://www.openstreetmap.org/directions?from=" & _ URLEncode(FromString) & "&to=" & URLEncode(LocationString) Case Else MsgBox ("No valid mapping service selected.") End Select Else MsgBox ("DrivingDirections has not been specified properly.") Exit Sub End If Set WshShell = CreateObject("WScript.Shell") WshShell.Run NavigationString Set WshShell = Nothing Else MsgBox ("No Calendar item selected") Exit Sub End If End Sub Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String 'URLEncode function taken from 'https://stackoverflow.com/questions/218181/ Dim StringLen As Long: StringLen = Len(StringVal) If StringLen > 0 Then ReDim result(StringLen) As String Dim i As Long, CharCode As Integer Dim Char As String, Space As String If SpaceAsPlus Then Space = "+" Else Space = "%20" For i = 1 To StringLen Char = Mid$(StringVal, i, 1) CharCode = Asc(Char) Select Case CharCode Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126 result(i) = Char Case 32 result(i) = Space Case 0 To 15 result(i) = "%0" & Hex(CharCode) Case Else result(i) = "%" & Hex(CharCode) End Select Next i URLEncode = Join(result, "") End If End Function