Display the Outlook GAL in Excel 2010 VBA Macro

Question

Hi I am looking to to be able to access the Outlook GAL within Excel. I am using Office 2010 so (excel 2010 and outlook 2010). What i am looking for is to be able to press a button and then the GAL will display a dialog box where i can then search for the recipients details I need and then insert into a cell. Having searched the internet I came across this code which works for Microsoft Word but when used in excel an error occurs.
Here is the code kindly provided from here http://www.vbaexpress.com/forum/archive/index.php/t-24694.html

Public Sub InsertAddressFromOutlook()   
    Dim strCode As String, strAddress As String
    Dim iDoubleCR As Integer

    'Set up the formatting codes in strCode
    strCode = "<PR_DISPLAY_NAME>" & vbCr & _
    "<PR_POSTAL_ADDRESS>" & vbCr & _
    "<PR_OFFICE_TELEPHONE_NUMBER>" & vbCr

    'Display the 'Select Name' dialog, which lets the user choose
    'a name from their Outlook address book

    strAddress = Application.GetAddress(AddressProperties:=strCode, _
                     UseAutoText:=False, DisplaySelectDialog:=1, _
                     RecentAddressesChoice:=True, UpdateRecentAddresses:=True)

    'If user cancelled out of 'Select Name' dialog, quit
    If strAddress = "" Then Exit Sub

    'Eliminate blank paragraphs by looking for two carriage returns in a row
    iDoubleCR = InStr(strAddress, vbCr & vbCr)
    Do While iDoubleCR <> 0
        strAddress = Left(strAddress, iDoubleCR - 1) & _
                     Mid(strAddress, iDoubleCR + 1)
        iDoubleCR = InStr(strAddress, vbCr & vbCr)
    Loop

    'Strip off final paragraph mark
    strAddress = Left(strAddress, Len(strAddress) - 1)

    'Insert the modified address at the current insertion point
    Selection.Range.Text = strAddress
End Sub

So when running this macro the return error is run time error 438, Object doesn't support this property or method
and the highlighted block of code for the error is

strAddress = Application.GetAddress(AddressProperties:=strCode, _
    UseAutoText:=False, DisplaySelectDialog:=1, _
    RecentAddressesChoice:=True, UpdateRecentAddresses:=True)

Can anyone provide a code solution Please? Thanks in advance

score 1 · Accepted Answer · answered Sep 23 '12 at 15:49

1

In order to get that dialog you need to open an instance of Word and then open the dialog inside Word. The code below will return the result to the ActiveCell. It uses late binding, which means it should run in earlier versions of Office as well:

Sub GetEmail()

Dim objWordApp As Object
Dim strCode As String
Dim strAddress As String
Dim lngDoubleCR As Long
'Set up the formatting codes in strCode
strCode = "<PR_DISPLAY_NAME>" & vbNewLine & _
          "<PR_POSTAL_ADDRESS>" & vbNewLine & _
          "<PR_OFFICE_TELEPHONE_NUMBER>"

' As GetAddress is not available in MS Excel, a call to MS Word object
' has been made to borrow MS Word's functionality
Application.DisplayAlerts = False
'On Error Resume Next
' Set objWordApp = New Word.Application
Set objWordApp = CreateObject("Word.Application")
strAddress = objWordApp.GetAddress(, strCode, False, 1, , , True, True)
objWordApp.Quit
Set objWordApp = Nothing
On Error GoTo 0
Application.DisplayAlerts = True

' Nothing was selected
If strAddress = "" Then Exit Sub

strAddress = Left(strAddress, Len(strAddress) - 1)

    'Eliminate blank paragraphs by looking for two carriage returns in a row
    lngDoubleCR = InStr(strAddress, vbNewLine & vbNewLine)
    Do While lngDoubleCR <> 0
        strAddress = Left(strAddress, lngDoubleCR - 1) & _
                     Mid(strAddress, lngDoubleCR + 1)
        lngDoubleCR = InStr(strAddress, vbNewLine & vbNewLine)
    Loop
ActiveCell.Value = strAddress
End Sub

answered Sep 23 '12 at 15:49

Doug Glancy

27,214
6
67
115

Hi Doug, thank you that is exactly what i needed that is perfect, I now have 1 small other dilemma i want to pull out also the email address which i am able to do using PR_EMAIL_ADDRESS, but unfortunately its not in a format i can use i.e. someone@address.com. it displays as /o=COMPANY/ou=Exchange Administrative Group (DHDHD3434DDDD)/cn=Recipients/cn=surname, Firstname. Is it possible to return as expected, Thanks Again – ward Sep 23 '12 at 19:31
I'm glad it works. I don't know how to get an actual email address using the GetAddress function. I was hoping there was another "PR_" argument, but I don't think so. I've googled around a bit and can't find anything. You might want to look into doing this by automating Outlook, instead of Word as we have here. – Doug Glancy Sep 24 '12 at 14:01
Hi Doug, I have come across this function which gets me the address I need, thought you may be interested, I cannot reference the website because i cannot find it again – ward Sep 25 '12 at 12:06
It does the job i need. so i just call it from your routine above passing the name and it returns the address. If you want to see I can post just let me know. Once again thanks for your help. – ward Sep 25 '12 at 12:12
Hi Doug here you go mate, 'Call using 'Target.Value = GetEmailAddress("Global Address List", Target.Value) Option Explicit Public Function GetEmailAddress(AddressList As String, UserName As String) 'Add reference to Microsoft Outlook object Library On Error Resume Next Dim oAddressList As AddressList Dim oAddressEntry As AddressEntry Dim sName As String Dim sEmail As String Set oAddressList = Outlook.GetNamespace("MAPI").AddressLists(AddressList) Do '**get name & email address for each address in list – ward Sep 25 '12 at 19:01
Set oAddressEntry = oAddressList.AddressEntries(UserName) If (LCase(UserName) = LCase(oAddressEntry.Name)) Then sEmail = "" sEmail = oAddressEntry.GetContact().Email1Address If (sEmail = "") Then sEmail = oAddressEntry.GetExchangeUser().PrimarySmtpAddress End If If (sEmail = "") Then sEmail = oAddressEntry.GetExchangeDistributionList().PrimarySmtpAddress End If End If Loop Until Not sEmail = "" GetEmailAddress = sEmail End Function – ward Sep 25 '12 at 19:04
sorry about the formatting and in 2 bits you can only add so many characters there is a bit of error I needed to add but you can see the basis of it. also need to temporarily turn off events. Ta – ward Sep 25 '12 at 19:05
Very good. I have some code that uses PrimarySmtpAddress, but didn't know how to get from what we had to that. Glad you found it. – Doug Glancy Sep 25 '12 at 19:07

Display the Outlook GAL in Excel 2010 VBA Macro

1 Answers1

Linked