AddFromOutlook Macro Isn't Working (1 Viewer)

[dgreen]

See attached.... I'm using the AddFromOutlook macro on a form, trying to get it to open Outlook and provide me with my Contacts, so I can populate the tblContacts. The error I'm getting is that this macro isn't available????

I have Access 2019. What am I doing wrong?
I've put the command button on the subform and the main form.
I've been able to use this function from the Access Templates but not using my own database.

I've looked for other solutions but haven't found one that works. I'd actually rather use vba code than a macro.
https://social.msdn.microsoft.com/F...ro-doesn39t-work-in-a-subform?forum=accessdev
I've put the button on both the main form and then subform.
https://social.msdn.microsoft.com/F...d-from-outlook-command-button?forum=accessdev
My instance of Office has been both open and closed.

 

[dgreen]

Even this approach isn't working
https://social.msdn.microsoft.com/F...ddfromoutlook-in-linked-table?forum=accessdev

VBA code below. I'm getting a User Defined error on the first line of code "Dim olApp As Outlook.Application"

Option Compare Database
Option Explicit

Private Sub AddFromOutlook_Click()

  Dim olApp As Outlook.Application
  Dim olns As Outlook.NameSpace
  Dim olDialog As SelectNamesDialog
  Dim olAddressList As Outlook.AddressList
  Dim olRecipient As Outlook.Recipient
  Dim olContactsFolder As Outlook.Folder
  Dim itm As Object
  Dim itms As Outlook.Items
  Dim blnContactsFolder As Boolean
  
  Set olApp = CreateObject("Outlook.Application")
  
  Set olns = olApp.GetNamespace("MAPI")

  'Pick the Outlook Contacts Folder of your choice
  Set olContactsFolder = olns.PickFolder

  ' Return the Focus to Access
  AppActivate "Microsoft Access"
 
  ' Make sure a Contacts Folder has been chosen
  If olContactsFolder Is Nothing Then
    MsgBox "Please select a Contacts Folder.", vbExclamation
    blnContactsFolder = False
  Else
    'Test whether folder is a Contacts folder
    If olContactsFolder.DefaultItemType <> 2 Then ' olContactItem = 2
      MsgBox "Please select a Contacts folder."
      blnContactsFolder = False
    Else
      blnContactsFolder = True
    End If
  End If

  If blnContactsFolder = True Then
    Set olDialog = olApp.Session.GetSelectNamesDialog
    
    'Loop through the AddressLists until we get the Default Outlook Contacts Folder
    For Each olAddressList In olApp.Session.AddressLists
      If olAddressList.GetContactsFolder = olContactsFolder Then
        Exit For
      End If
    Next
      
     With olDialog
      'Set the Dialog to use the Default Outlook Contacts Folder
      .InitialAddressList = olAddressList
      .ShowOnlyInitialAddressList = True
      
      'Select the Names using the Dialog
      If .Display Then
        'Loop through selections and check for match
        For Each olRecipient In olDialog.Recipients
        
          'Loop through each Contact item in the Folder to check for a match
          For Each itm In olContactsFolder.Items
          
            'Verify the Item is a Contact Item by Class
            If itm.Class = 40 Then '40 = olContact
            
              'Match on finding itm.EntryID within olRecipient.EntryID
              If InStr(1, olRecipient.EntryID, itm.EntryID) > 0 Then
              
                'Replace this code with code to insert or update records in Access table
                'Either use an action query or a recordset
                Debug.Print "olRecipient.Name: " & olRecipient.Name
                Debug.Print "itm.FileAs: " & itm.FileAs
                Debug.Print "itm.FirstName: " & itm.FirstName
                Debug.Print "itm.LastName: " & itm.LastName
                Debug.Print "itm.Email1Address: " & itm.Email1Address
                Debug.Print "itm.Email2Address: " & itm.Email2Address
                Debug.Print "itm.Email3Address: " & itm.Email3Address
                Debug.Print "olRecipient.Address: " & olRecipient.Address
                Debug.Print "olRecipient.AddressEntry: " & olRecipient.AddressEntry
                Debug.Print "olRecipient.Index: " & olRecipient.Index
                Debug.Print "olRecipient.Type: " & olRecipient.Type
                Debug.Print "olRecipient.EntryID: " & olRecipient.EntryID
                Debug.Print "itm.EntryID: " & itm.EntryID
                Debug.Print "---------------------------------------------------"
              End If
            End If
          Next itm
        Next olRecipient
      End If
    End With
  End If
  
  Set itm = Nothing
  Set itms = Nothing
  Set olAddressList = Nothing
  Set olContactsFolder = Nothing
  Set olDialog = Nothing
  Set olns = Nothing
  Set olApp = Nothing

End Sub

 

[dgreen]

Updated the database with both approaches, both failing to work.

 

[dgreen]

@MajP any thoughts on this?

 

[arnelgp]

on VBA editor, menu, Tools->References...
you add reference to Microsoft Outlook XX.X Object Library. "XX.X" is the version Number that you have.

 

[dgreen]

Got a little further with the VBA code.... Then the next error I get is on the line

  ' Return the Focus to Access
  AppActivate "Microsoft Access"

Am I supposed to change the information in the " "?

 

[dgreen]

Trying this approach.... Definitely seems like someone didn't finish the code if this work around works.

ADDFROMOUTLOOK Macro Help - Microsoft Access / VBA

ADDFROMOUTLOOK Macro Help. Microsoft Access / VBA Forums on Bytes.

bytes.com

 

[arnelgp]

you are missing that function (appActivate).
anyway, you don't need that code if you are running it on access itself.

 

[dgreen]

ok commented it out. click button, select folder opens, select the contacts folder, when that opens it looks like it's trying to figure out who to email. It shows the names but below it shows to:, CC: and BC:.
When I select a name or multiple names and click ok, nothing happens other than the Outlook selection box closes. No error, but also no values in the Access table.

 

[dgreen]

While, I'd love to figure this out, I found that if I import the Contacts table from the Access templates, the AddToContact macro works. I can then change the names of the fields, the table name back to my original table.

 

[arnelgp]

frankly, I have no idea what the code does.
I will just try to help you figure it out.
you need to debug and trace the code so you know which lines are being
executed.
click on this line "Private Sub AddFromOutlook_Click()"
press F9 to debug that line.
run your form and click on the button.
you will return to the VBE. press F8 until you error or until the code stops.

 

[dgreen]

Thanks for the attempt. Will continue to troubleshoot.