Add single Outlook contact to Access form

[knarlyd@hotmail.com]

Microsoft has a Desktop Student Database template (Access 2010) that does exactly what I'm trying to do:
open the Outlook Contacts dialog box, select a contact from the GAL, and then programmatically save it to a record in one of my tables.

I've tried simulating the button/coding on my data entry form, but I'm getting the error:

"The command or action 'AddFromOutlook' isn't available now"

I've search high and low but have only found a reference to creating a temp contacts table to import all the contacts. I'm looking for something more robust.

Any ideas on how I can accomplish this and/or point me to a possible solution?

Sorry if it's unclear, I'm somewhat new to Access 2010 and not up on any VBA coding so any code would also be appreciated.

Thanks!

 

[Estuardo]

G'd Morning,
You can get all contacts from Outlook in several ways:
1. Manually export all your contacts from Outlook
2. Link your Address Book to Access
3. Automate from VBA.

Manually export:
This is ok if you don't want to keep your Address book in Sync with Access

Link Outlook Address book to Access:
This may be the one you're looking for. This is a flexible solution if you don't want to keep separated copies of your contacts.

Automate With VBA.
If you're new to VBA, this may be a little complex. Any way here is simple snippet for you to play around. This code will get all your contacts from Outlook and display the result in the immediate window (ctrl+g)

Public Sub GetContacts()
On Error GoTo ErrHanlder
'Add Reference to Microsoft Outlook x.x Object Library
  Dim ola As Outlook.Application
  Dim olns As Outlook.NameSpace
  Dim cti As Outlook.ContactItem
  Dim cf As Outlook.MAPIFolder
  Dim objItems As Outlook.Items
  
  Dim intItems As Integer
  Dim i As Integer
  Dim Ex As String
  
    Set ola = New Outlook.Application
    Set olns = ola.GetNamespace("MAPI")
    Set cf = olns.GetDefaultFolder(olFolderContacts)
    Set objItems = cf.Items
    
    intItems = objItems.Count
    If intItems > 0 Then
        For i = 1 To intItems
            If TypeName(objItems(i)) = "ContactItem" Then
                Set cti = objItems(i)
                    With cti
                       Debug.Print .FullName
                       Debug.Print .CompanyName
                       Debug.Print .MobileTelephoneNumber
                    End With
                               
            End If
        Next i
    End If
     
Exit_Here:
Set ola = Nothing
Set cti = Nothing
Set olns = Nothing
Set cf = Nothing
Set objItems = Nothing
Exit Sub

ErrHandler:
   Ex = Ex & Err.Number
   Ex = Ex & " " & vba.vbCrLf & " "
   Ex = Ex & Err.Description
   Ex = Ex & "modOutlook"
   Ex = Ex & "GetContacts"
   Ex = Ex & Now
   MsgBox Ex
Resume Exit_Here
Resume 0    '.FOR TROUBLESHOOTING

End Sub

G'd luck

 

[knarlyd@hotmail.com]

Thanks much!

I will give it a try.