Results 1 to 5 of 5
  1. #1
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9

    Question Export Access data to specific group in shared Outlook mailbox


    Hello my friends,
    I have an Access form whose data I would like to export to some groups within the Outlook contacts of a shared mailbox. The following VBA code gives me a runtime error 13 (type mismatch) on row 19 (Next)

    Code:
    Dim MyOutlook As Outlook.Application
    Dim KontaktOutlook As Outlook.ContactItem
    Dim SharedMailboxName As String
    Dim SharedContactsFolder As Outlook.Folder
    Dim MemberGroup As Outlook.DistListItem
    Dim TeamGroup As Outlook.DistListItem
    Dim olDistributionList As Outlook.OlItemType
    
    SharedMailboxName = "shared.mail@example.com"
    
    Set MyOutlook = CreateObject("Outlook.Application")
    Set SharedContactsFolder = MyOutlook.Session.Folders(SharedMailboxName).Folders("Contacts")
    
    ' Get the Member group
    For Each MemberGroup In SharedContactsFolder.Items
        If MemberGroup.Class = olDistributionList And MemberGroup.DLName = "Member" Then
            Exit For
        End If
    Next
    
    ' Get the group defined under .JobTitle
    For Each TeamGroup In SharedContactsFolder.Items
        If TeamGroup.Class = olDistributionList And TeamGroup.GroupName = Nz(Me!txtTeam) Then
            Exit For
        End If
    Next
    
    ' Insert the textbox values from the form
    Set KontaktOutlook = SharedContactsFolder.Items.Add(olContactItem)
    With KontaktOutlook
        .FirstName = Nz(Me![First Name])
        .LastName = Nz(Me![Last Name])
        .CompanyName = "Member"
        .JobTitle = Nz(Me!txtTeam)
        .HomeAddressStreet = Nz(Me!Address)
        .HomeAddressCity = Nz(Me!City)
        .HomeAddressPostalCode = Nz(Me!ZIP)
        .BusinessTelephoneNumber = Nz(Me![Business Phone])
        .HomeTelephoneNumber = Nz(Me![Home Phone])
        .MobileTelephoneNumber = Nz(Me![Mobile Phone])
        .Email1Address = Nz(Me![E-mail Address])
        If Not IsNull(Me!Birthday) Then
            .Birthday = Me!Birthday
        End If
        .Save
        .AddToGroup MemberGroup
        .AddToGroup TeamGroup
    End With
    
    Set KontaktOutlook = Nothing
    Set MyOutlook = Nothing
    
    MsgBox "Contact saved in Outlook"
    Could somebody give me a hint where I made the mistake or how to solve that problem? Thank you in advance!

  2. #2
    Gicu's Avatar
    Gicu is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,101
    Try to declare the MemberGroup as Outlook.Items instead of DistListItem:
    https://learn.microsoft.com/en-us/of...item.getmember
    Cheers,
    Vlad Cucinschi
    MS Access Developer
    http://forestbyte.com/

  3. #3
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9
    Thank you for the fast answer Vlad.
    I tried your recommendation and I also tried to declare it as Object but got the same error 13. Dunno what to try further!?
    Cheers back.

  4. #4
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9

    Cool [solved]

    At last, after some time of experimenting, I could finally solve the problem.
    I found the following link from forum member June7 that helped me a lot:
    How to get access to Contact Group folder in Outlook

    in this thread:
    can I create/update an Outlook email group from my Access data?

    Now I was able to achieve my goal and to save the contact in the Member group and in the group defined under the combobox txtTeam with one mouse click.
    The complete and working code now is as follows:

    Code:
    Private Sub cmdSaveAsOutlookContact_Click()
    'Declare variables for Outlook objects
    Dim olNS As Outlook.NameSpace
    Dim olContactFolder As Outlook.MAPIFolder
    Dim olTeamGroup As Outlook.MAPIFolder
    Dim olMemberGroup As Outlook.MAPIFolder
    Dim olTeamContact As Outlook.ContactItem
    Dim olMemberContact As Outlook.ContactItem
    Dim olTeamItems As Outlook.Items
    Dim olMemberItems As Outlook.Items
    
    'Name of shared mailbox
    SharedMailboxName = "shared.mail@example.com"
    
    'Error handling
    On Error Resume Next
    
    'Get the Outlook namespace and the contact folder in the shared mailbox
    Set olNS = GetNamespace("MAPI")
    Set olContactFolder = olNS.Folders(SharedMailboxName).Folders("Contacts")
    
    'Check the value of the txtTeam field and set the corresponding Team group folder
    If Nz(Me!txtTeam) = "FG 1" Then
    Set olTeamGroup = olContactFolder.Folders("FG 1")
    ElseIf Nz(Me!txtTeam) = "FG 2" Then
    Set olTeamGroup = olContactFolder.Folders("FG 2")
    ElseIf Nz(Me!txtTeam) = "FG 3" Then
    Set olTeamGroup = olContactFolder.Folders("FG 3")
    ElseIf Nz(Me!txtTeam) = "FG 4 Digital" Then
    Set olTeamGroup = olContactFolder.Folders("FG 4 Digital")
    End If
    
    'Get the Member group folder
    Set olMemberGroup = olContactFolder.Folders("Member")
    
    ' Check if contact already exists in Team folder
    email = Nz(Me![E-mail Address])
    If Not olTeamGroup Is Nothing Then
    Set olTeamItems = olTeamGroup.Items
    For Each olTeamContact In olTeamItems
    If olTeamContact.Class = olContact And olTeamContact.Email1Address = email Then
    MsgBox "Contact already exists in the '" & Nz(Me!txtTeam) & "' Group."
    Exit Sub
    End If
    Next
    End If
    
    ' Check if contact already exists in Member folder
    If Not olMemberGroup Is Nothing Then
    Set olMemberItems = olMemberGroup.Items
    For Each olMemberContact In olMemberItems
    If olMemberContact.Class = olContact And olMemberContact.Email1Address = email Then
    MsgBox "Contact already exists in the 'Member' Group."
    Exit Sub
    End If
    Next
    End If
    
    'If the Team group folder is found, create a contact in it
    If Not olTeamGroup Is Nothing Then
    Set olTeamItems = olTeamGroup.Items
    Set olTeamContact = olTeamItems.Add(olContactItem)
    With olTeamContact
    .FirstName = Nz(Me![First Name])
    .LastName = Nz(Me![Last Name])
    .CompanyName = "Member"
    .JobTitle = Nz(Me!txtTeam)
    .HomeAddressStreet = Nz(Me!Address)
    .HomeAddressCity = Nz(Me!City)
    .HomeAddressPostalCode = Nz(Me!ZIP)
    .BusinessTelephoneNumber = Nz(Me![Business Phone])
    .HomeTelephoneNumber = Nz(Me![Home Phone])
    .MobileTelephoneNumber = Nz(Me![Mobile Phone])
    .Email1Address = Nz(Me![E-mail Address])
    If Not IsNull(Me!Birthday) Then
        .Birthday = Me!Birthday
    End If
    .Save
    End With
    End If
    
    'If the Member group folder is found, create a contact in it
    If Not olMemberGroup Is Nothing Then
    Set olMemberItems = olMemberGroup.Items
    Set olMemberContact = olMemberItems.Add(olContactItem)
    With olMemberContact
    .FirstName = Nz(Me![First Name])
    .LastName = Nz(Me![Last Name])
    .CompanyName = "Member"
    .JobTitle = Nz(Me!txtTeam)
    .HomeAddressStreet = Nz(Me!Address)
    .HomeAddressCity = Nz(Me!City)
    .HomeAddressPostalCode = Nz(Me!ZIP)
    .BusinessTelephoneNumber = Nz(Me![Business Phone])
    .HomeTelephoneNumber = Nz(Me![Home Phone])
    .MobileTelephoneNumber = Nz(Me![Mobile Phone])
    .Email1Address = Nz(Me![E-mail Address])
    If Not IsNull(Me!Birthday) Then
        .Birthday = Me!Birthday
    End If
    .Save
    End With
    End If
    
    ' Save the contact to both groups
    olTeamContact.Move olTeamGroup
    olMemberContact.Move olMemberGroup
    
    'Clean up
    Set olTeamContact = Nothing
    Set olMemberContact = Nothing
    Set olTeamItems = Nothing
    Set olMemberItems = Nothing
    Set olNS = Nothing
    Set olTeamGroup = Nothing
    Set olMemberGroup = Nothing
    Set olContactFolder = Nothing
    
    MsgBox "Contact saved in the group 'Member' and '" & Nz(Me!txtTeam) & "'."
    
    End Sub

  5. #5
    MXQ's Avatar
    MXQ is offline Novice
    Windows 10 Office 365
    Join Date
    Aug 2020
    Posts
    9
    Forgot one line within the With statement:
    Code:
    With olTeamContact
    ...
    .FileAs = .FirstName & " " & .LastName
    ...
    End With
    
    With olMemberContact
    ...
    .FileAs = .FirstName & " " & .LastName
    ...
    End With
    Otherwise the Display As field would be empty.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. can I create/update an Outlook email group from my Access data?
    By jimdharris in forum Import/Export Data
    Replies: 2
    Last Post: 08-31-2015, 10:07 AM
  2. Access - Outlook Appointment shared calendar
    By Guerra67 in forum Access
    Replies: 1
    Last Post: 09-21-2014, 07:26 PM
  3. Replies: 8
    Last Post: 08-06-2012, 10:23 PM
  4. Access link to Outlook mailbox
    By chodges in forum Programming
    Replies: 0
    Last Post: 01-06-2012, 12:11 PM
  5. Assigning Outlook task from shared Outlook mailbox
    By Remster in forum Programming
    Replies: 2
    Last Post: 11-16-2011, 04:38 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums