Outlook to Access

[Sprinks]

We have a number of Contacts with multiple specialties. In an evolving
network-wide enterprise application, we need to access and do keyword
searches on this contact information from within Access.

Our user base, however, including me, has become comfortable with Outlook.
I was wondering whether, on opening our Access application, we could
programmatically update the Access Contacts table with a snapshot of the
shared Contacts folder in Outlook.

Thanks for any input.

Sprinks

 

[Andy]

Does this get you started? (don't forget to set the References to pick up
your Outlook Application Object library :-

Sub Contacts()

Dim objOutlook As Outlook.Application
Dim objOutlookExp As Object
Dim objContacts As Object
Dim ii As Integer

On Error GoTo Err_Contacts

Set objOutlook = New Outlook.Application

Set objContacts =
objOutlook.Session.GetDefaultFolder(olFolderContacts)

If objContacts = "Contacts" Then

ii = 1

Do While ii <= objContacts.Items.Count

MsgBox objContacts.Items(ii)

ii = ii + 1
Loop
Else
MsgBox "No Contacts Folder"
End If

Set objContacts = Nothing
Set objOutlook = Nothing

Exit_Contacts:

Exit Sub

Err_Contacts:

MsgBox Err.Number
MsgBox Err.Description
Resume Exit_Contacts

End Sub

Andy.

 

[Sprinks]

Thanks, Andy!

Does this get you started? (don't forget to set the References to pick up
your Outlook Application Object library :-

Sub Contacts()

Dim objOutlook As Outlook.Application
Dim objOutlookExp As Object
Dim objContacts As Object
Dim ii As Integer

On Error GoTo Err_Contacts

Set objOutlook = New Outlook.Application

Set objContacts =
objOutlook.Session.GetDefaultFolder(olFolderContacts)

If objContacts = "Contacts" Then

ii = 1

Do While ii <= objContacts.Items.Count

MsgBox objContacts.Items(ii)

ii = ii + 1
Loop
Else
MsgBox "No Contacts Folder"
End If

Set objContacts = Nothing
Set objOutlook = Nothing

Exit_Contacts:

Exit Sub

Err_Contacts:

MsgBox Err.Number
MsgBox Err.Description
Resume Exit_Contacts

End Sub

Andy.