A Microsoft Outlook email forum. Outlook Banter

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Mapping Annoyance



 
 
Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1  
Old November 30th 07, 08:23 PM posted to microsoft.public.office.developer.outlook.vba,microsoft.public.outlook.program_vba
Matt Williamson
external usenet poster
 
Posts: 21
Default Mapping Annoyance

Since MS decided to hard code (or put somewhere other than the registry)
http://r.office.microsoft.com/r as the default location for the map button
in Outlook 2003 and it can no longer be changed in the registry using the
MapScriptURL registry value, I decided to write some code to give better
options. I wrote this as a replacement to the map button on the contact form
so it only works when a contact is open and has an address set as the
mailing address.

'Code Start

Option Explicit

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
_
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
ByVal _
lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
_
As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Enum MappingService
Google = 1
Expedia = 2
Mappoint = 3
MapQuest = 4
YahooMaps = 5
End Enum


Sub openmap()
OpenMapFromContact Google
End Sub


Sub OpenMapFromContact(Map As MappingService)

Dim itm As Outlook.ContactItem, s As String
Dim sStreet As String, sCity As String, sZip As String
Dim sState As String, sURL As String, dw As Long
Dim sAddy As String

Set itm = Application.ActiveInspector.CurrentItem
With itm
sStreet = .MailingAddressStreet
sCity = .MailingAddressCity
sState = .MailingAddressState
sZip = .MailingAddressPostalCode
End With

Select Case Map
Case 1:
sAddy = Replace(sStreet & " " & sCity & " " & sState & " " & sZip, "
", "+")
sURL = "http://maps.google.com/maps?q=" & sAddy & "&t=h"
Case 2
sStreet = Replace(sStreet, " ", "+")
sURL =
"http://www.expedia.com/City-Map?action=findAMap%40results&findAMap_addressPlac e_choice=0&"
& _
"findAMap_addressPlace_country=USA&findAMap_addres sPlace_street=" &
sStreet & _
"&findAMap_addressPlace_city=" & sCity &
"&findAMap_addressPlace_state=" & sState & "&findAMap_addressPlace_zip=" &
sZip & _
"&findAMap_addressPlace_placeRegion=0&findAMap_add ressPlace_flag=0&findAMap_submitted=1"
Case 3
sURL = "http://mappoint.msn.com/home.aspx?strt1=" & sStreet &
"&city1=" & sCity & "&stnm1=" & sState & "&zipc1=" & sZip
Case 4
sURL = "http://www.mapquest.com/maps/map.adp?address=" & sStreet &
"&city=" & sCity & "&state=" & sState & "&zip=" & sZip
Case 5
sAddy = Replace(sStreet & " " & sCity & " " & sState & " " & sZip, "
", "+")
sURL = "http://maps.yahoo.com/maps_result.php?q1=" & sAddy
End Select


dw = GetDesktopWindow

Call ShellExecute(dw, "open", sURL, vbNullString, vbNullString, 5)

End Sub

'Code End

Matt


 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Annoyance - not enough memory??? G-Artist Outlook Express 8 November 10th 06 04:17 AM
weird problem[?] annoyance with "Send/Receive" behavior and the Outbox albert Outlook - General Queries 5 October 18th 06 03:47 PM
Minor annoyance: inbox scrollbar at top Stuart Reed Outlook Express 3 August 29th 06 11:46 AM
Envelope mapping???? Doug Joy Outlook - Using Contacts 1 June 13th 06 03:58 AM
Major Annoyance moving from Windows Messaging to Outlook 2000 [email protected] Outlook - General Queries 0 May 9th 06 06:47 AM


All times are GMT +1. The time now is 11:56 AM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2025 Outlook Banter.
The comments are property of their posters.