lauren quantrell <la************ *@hotmail.com> wrote:
Is there a way to open the MS Outlook address book using VBA and then
be able to do something with the return value?
I want users to click an icon to open the Outlook address book then
when an address is selected, populate an Access field with the
address. Is this remotely possible?
Thanks,
lq
I have programmed a routine that works the other way and creates an
Outlook Address Book from Access data... so I'm sure you can do the
opposite.
Below is my code which may be hepful?
Function CreateOutlookCo ntacts()
On Error GoTo CreateOutlookCo ntacts_err
'prompt user
Dim r As Long, myMsg As String
r = MsgBox("BIGCare will create a 'BIGCare Contacts' folder in
Microsoft Outlook. Continue?", vbQuestion + vbOKCancel +
vbDefaultButton 1, "Outlook Contacts")
If r <> vbOK Then Exit Function
Dim rsPerson As DAO.Recordset
Dim CountTotal As Long, CountRec As Long, OutputForm As String, i As
Long
Dim myOlApp As New Outlook.Applica tion
Dim myNameSpace As Outlook.NameSpa ce
Dim myFolder As Outlook.MAPIFol der
Dim myContactFolder As Outlook.MAPIFol der
Dim myItem As Outlook.Contact Item
Dim myOlBar As Outlook.Outlook BarPane
Dim myOlGroup As Outlook.Outlook BarGroup
Dim myOlBarShortcut As Outlook.Outlook BarShortcut
Dim myExplorer As Outlook.Explore r
Set rsPerson = CurrentDb.OpenR ecordset("qryOu tlookExport",
DB_OPEN_SNAPSHO T)
Set myOlApp = CreateObject("O utlook.Applicat ion")
Set myNameSpace = myOlApp.GetName space("MAPI")
Set myFolder = myNameSpace.Get DefaultFolder(o lFolderContacts )
'Check some people records exist
If rsPerson.Record Count = 0 Then Exit Function
rsPerson.MoveLa st
CountTotal = rsPerson.Record Count
CountRec = 0
OutputForm = "frmOutlookProg ress"
DoCmd.OpenForm OutputForm
GV_CANCEL = False
'Initial progress message
Forms(OutputFor m)![lblStatus].Caption = "Deleting BIGCare Contacts
folder..."
Forms(OutputFor m).Repaint
'Contact Folder
'Delete contacts folder
For i = 1 To myFolder.Folder s.Count
If myFolder.Folder s.Item(i).Name = "BIGCare Contacts" Then
myFolder.Folder s.Remove (i)
Exit For
End If
Next
'Create folder
Set myContactFolder = myFolder.Folder s.Add("BIGCare Contacts",
olFolderContact s)
'Shortcut
Set myExplorer = myOlApp.ActiveE xplorer
If TypeName(myExpl orer) = "Nothing" Then 'test if Outlook open
already
Set myExplorer = myFolder.GetExp lorer
End If
Set myOlBar = myExplorer.Pane s.Item("Outlook Bar")
Set myOlGroup = myOlBar.Content s.Groups.Item(1 )
'check if shortcut alrady exists and delete
For i = 1 To myOlGroup.Short cuts.Count
If myOlGroup.Short cuts.Item(i).Na me = "BIGCare Contacts" Then
myOlGroup.Short cuts.Remove (i)
Exit For
End If
Next
'Create shortcut
Set myOlBarShortcut = myOlGroup.Short cuts.Add(myCont actFolder,
"BIGCare Contacts")
On Error GoTo CreateOutlookCo ntacts_err
'Create contacts from people records
rsPerson.MoveFi rst
Do Until rsPerson.EOF Or GV_CANCEL
If apiGetAsyncKeyS tate(VK_ESCAPE) Then GV_CANCEL = True 'give user
option to cancel
Set myItem = myContactFolder .Items.Add(olCo ntactItem)
If Len(rsPerson![GivenName]) > 0 Then myItem.FirstNam e =
rsPerson![GivenName]
If Len(rsPerson![SurnameSCR]) > 0 Then myItem.LastName =
rsPerson![SurnameSCR]
If Len(rsPerson![email]) > 0 Then myItem.Email1Ad dress =
rsPerson![email]
If Len(rsPerson![HomePhone]) > 0 Then myItem.HomeTele phoneNumber =
rsPerson![HomePhone]
If Len(rsPerson![WorkPhone]) > 0 Then myItem.Business TelephoneNumber
= rsPerson![WorkPhone]
If Len(rsPerson![MobilePhone]) > 0 Then myItem.MobileTe lephoneNumber
= rsPerson![MobilePhone]
If Len(rsPerson![HomeFax]) > 0 Then myItem.HomeFaxN umber =
rsPerson![HomeFax]
If Len(rsPerson![WorkFax]) > 0 Then myItem.Business FaxNumber =
rsPerson![WorkFax]
If Len(rsPerson![Address1]) > 0 Then myItem.HomeAddr essStreet =
rsPerson![Address1]
If Len(rsPerson![Address2]) > 0 Then myItem.HomeAddr essStreet =
rsPerson![Address2]
If Len(rsPerson![Suburb]) > 0 Then myItem.HomeAddr essCity =
rsPerson![Suburb]
If Len(rsPerson![Country]) > 0 Then myItem.HomeAddr essCountry =
rsPerson![Country]
If Len(rsPerson![PostCode]) > 0 Then myItem.HomeAddr essPostalCode =
rsPerson![PostCode]
If Len(rsPerson![PostalAddress1]) > 0 Then
myItem.MailingA ddressStreet = rsPerson![PostalAddress1]
If Len(rsPerson![PostalAddress2]) > 0 Then
myItem.MailingA ddressStreet = rsPerson![PostalAddress2]
If Len(rsPerson![PostalSuburb]) > 0 Then myItem.MailingA ddressCity =
rsPerson![PostalSuburb]
If Len(rsPerson![PostalCountry]) > 0 Then
myItem.MailingA ddressCountry = rsPerson![PostalCountry]
If Len(rsPerson![PostalPostCode]) > 0 Then
myItem.MailingA ddressPostalCod e = rsPerson![PostalPostCode]
myItem.Save
'Update progress indicator
CountRec = CountRec + 1
Forms(OutputFor m)![lblStatus].Caption = CountRec & " of " &
CountTotal
Forms(OutputFor m)![bxProgress].Width = (8 / CountTotal) * CountRec *
567
Forms(OutputFor m).Repaint
rsPerson.MoveNe xt
Loop
If GV_CANCEL Then
Forms(OutputFor m)!lblEscape.Ca ption = "Cancelled"
Else
Forms(OutputFor m)!lblEscape.Ca ption = "Done"
End If
Forms(OutputFor m)![btnOK].Visible = True
myMsg = "To make the Contact Folder appear in your Address Book please
do the following: " & Chr(10)
myMsg = myMsg & Chr(10) & "- Right-click on the 'BIGCare Contacts'
shortcut in Outlook"
myMsg = myMsg & Chr(10) & "- Select 'Properties' from the menu"
myMsg = myMsg & Chr(10) & "- Under the 'Outlook Address Book' tab tick
the box"
myMsg = myMsg & Chr(10) & " labelled 'Show this folder as an e-mail
Address Book'"
myMsg = myMsg & Chr(10) & "- Click 'OK'"
MsgBox myMsg, vbInformation + vbOKOnly, "Outlook Contacts"
CreateOutlookCo ntacts_exit:
'Clean up
Set myExplorer = Nothing
Set myOlBarShortcut = Nothing
Set myOlGroup = Nothing
Set myOlBar = Nothing
Set myItem = Nothing
Set myContactFolder = Nothing
Set myFolder = Nothing
Set myNameSpace = Nothing
Set myOlApp = Nothing
Set rsPerson = Nothing
Exit Function
CreateOutlookCo ntacts_err:
MsgBox err.Description , 48, "Error in CreateOutlookCo ntacts()"
Resume CreateOutlookCo ntacts_exit
End Function
--
regards,
Bradley
A Christian Response
http://www.pastornet.n et.au/response
