xjetjockey
01-12-2009, 05:57 AM
I have a program below that opens the Outlook Address Book. The user selects an address, and the Contact info is put on the sheet. Works great, BUT, I don't know how to programatically select the dialog box, and then programatically go back to Excel. As it now stands I have to manually select Outlook to see the dialog box, and then manually select Excel to get back to my program. Sorry if this is basic stuff, but I'm just a noob.
Sub SetContactsFolderAsInitialAddressList()
Dim oMsg As Outlook.MailItem
Set oMsg = Outlook.Application.CreateItem(olMailItem)
Dim oDialog As Outlook.SelectNamesDialog
Set oDialog = Outlook.Application.Session.GetSelectNamesDialog
Dim oAL As Outlook.AddressList
Dim oContacts As Outlook.Folder
Dim cEI As String
Dim c As Outlook.AddressEntry
Dim olRecipient As Outlook.Recipient
Set oContacts = _
Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
On Error GoTo HandleError
'Look for the AddressList for the default Contacts folder
For Each oAL In Outlook.Application.Session.AddressLists
If oAL.AddressListType = olOutlookAddressList Then
If oAL.GetContactsFolder.EntryID = _
oContacts.EntryID Then
Exit For
End If
End If
Next
With oDialog
.Caption = "Select Customer Contact"
.ToLabel = "Customer C&ontact"
.NumberOfRecipientSelectors = olShowTo
.InitialAddressList = oAL
.AllowMultipleSelection = False
'Let the selected names be the recipients of the new message
.Recipients = oMsg.Recipients
If .Display Then
'Recipients Resolved
For Each olRecipient In .Recipients
cEI = olRecipient.EntryID 'entry id of selected contact
Set c = Outlook.Application.Session.GetAddressEntryFromID(cEI)
Worksheets("Sheet1").Range("A1") = c.GetContact.Email1Address
Worksheets("Sheet1").Range("A2") = c.GetContact.FirstName
Worksheets("Sheet1").Range("A3") = c.GetContact.LastName
Worksheets("Sheet1").Range("A4") = c.GetContact.BusinessFaxNumber
Worksheets("Sheet1").Range("A5") = c.GetContact.BusinessTelephoneNumber
Worksheets("Sheet1").Range("A6") = c.GetContact.BusinessAddressStreet
Worksheets("Sheet1").Range("A7") = c.GetContact.BusinessAddressCity
Worksheets("Sheet1").Range("A8") = c.GetContact.BusinessAddressState
Worksheets("Sheet1").Range("A9") = c.GetContact.BusinessAddressPostalCode
Worksheets("Sheet1").Range("A10") = c.GetContact.CompanyName
Next
End If
End With
HandleError:
Exit Sub
End Sub
Sub SetContactsFolderAsInitialAddressList()
Dim oMsg As Outlook.MailItem
Set oMsg = Outlook.Application.CreateItem(olMailItem)
Dim oDialog As Outlook.SelectNamesDialog
Set oDialog = Outlook.Application.Session.GetSelectNamesDialog
Dim oAL As Outlook.AddressList
Dim oContacts As Outlook.Folder
Dim cEI As String
Dim c As Outlook.AddressEntry
Dim olRecipient As Outlook.Recipient
Set oContacts = _
Outlook.Application.Session.GetDefaultFolder(olFolderContacts)
On Error GoTo HandleError
'Look for the AddressList for the default Contacts folder
For Each oAL In Outlook.Application.Session.AddressLists
If oAL.AddressListType = olOutlookAddressList Then
If oAL.GetContactsFolder.EntryID = _
oContacts.EntryID Then
Exit For
End If
End If
Next
With oDialog
.Caption = "Select Customer Contact"
.ToLabel = "Customer C&ontact"
.NumberOfRecipientSelectors = olShowTo
.InitialAddressList = oAL
.AllowMultipleSelection = False
'Let the selected names be the recipients of the new message
.Recipients = oMsg.Recipients
If .Display Then
'Recipients Resolved
For Each olRecipient In .Recipients
cEI = olRecipient.EntryID 'entry id of selected contact
Set c = Outlook.Application.Session.GetAddressEntryFromID(cEI)
Worksheets("Sheet1").Range("A1") = c.GetContact.Email1Address
Worksheets("Sheet1").Range("A2") = c.GetContact.FirstName
Worksheets("Sheet1").Range("A3") = c.GetContact.LastName
Worksheets("Sheet1").Range("A4") = c.GetContact.BusinessFaxNumber
Worksheets("Sheet1").Range("A5") = c.GetContact.BusinessTelephoneNumber
Worksheets("Sheet1").Range("A6") = c.GetContact.BusinessAddressStreet
Worksheets("Sheet1").Range("A7") = c.GetContact.BusinessAddressCity
Worksheets("Sheet1").Range("A8") = c.GetContact.BusinessAddressState
Worksheets("Sheet1").Range("A9") = c.GetContact.BusinessAddressPostalCode
Worksheets("Sheet1").Range("A10") = c.GetContact.CompanyName
Next
End If
End With
HandleError:
Exit Sub
End Sub