Distribution List in Access

[lshields]

Is there a way that I can take a table of names and insert them into a Microsoft Outlook Distribution List? If so can someone please show me the code to accomplish this task?

Thanks

 

[tonyflavell]

Hi there

I use the following code to add a new contact to Outlook. I'm sure it can be modified to do what you want with the inclusion of a loop through the table of names.

Declarations

Public golApp As Outlook.Application
Public golNameSpace As Outlook.NameSpace

Initialise Outlook

Function InitializeOutlook() As Boolean
On Error GoTo Init_Err
    
    Set golApp = New Outlook.Application
    Set golNameSpace = golApp.GetNamespace("MAPI")
    InitializeOutlook = True

Init_Bye:
    
    Exit Function

Init_Err:
    
    InitializeOutlook = False
    Resume Init_Bye
    
End Function

Add Contact Code

Function AddContact() As Boolean
Dim objFolder As MapiFolder, objNewContact As ContactItem, objForm As Form
Dim objTempContact As ContactItem
Dim prpUserProp As UserProperty
Dim strCustID As String, strFullName As String
    
    Const conItemNotfound As Long = -2147352567
    
    On Error Resume Next
    AddContact = False
    
    If golApp Is Nothing Then
        If InitializeOutlook = False Then
            MsgBox "Unable to initialize Outlook Application or Namespace object variables!"
        End If
    End If
    
    Set objFolder = golNameSpace.GetDefaultFolder(olFolderContacts)
    Set objForm = Forms!frmEnquiryMaster!frmContactDetails.Form!ContactName
    
    If objForm.NewRecord Then
        MsgBox "You are on a new record.  Please save this record before attempting to add the contact information to your contact manager."
        AddContact = False
        GoTo AddNew_Bye:
    End If
    
    If objFolder.Items(objForm!ContactName.Value).CustomerID = objForm!CustomerID Then
       
       If Err = 0 Then
            If MsgBox(objForm!ContactName.Value & " already exists in your " _
                & "collection of contacts. Do you want to add the current information " _
                & "as a duplicate record?", vbInformation + vbYesNo, _
                "Record already exists") = vbNo Then
                GoTo AddNew_Bye:
            End If
        ElseIf Err <> conItemNotfound Then
            GoTo AddNew_Err
        End If
    End If
    
    Set objNewContact = objFolder.Items.Add
    
    With objNewContact
        .FirstName = Left(objForm!ContactName.Text, InStr(objForm!ContactName.Text, " ") - 1)
        .LastName = Mid(objForm!ContactName.Text, InStr(objForm!ContactName.Text, " ") + 1)
        .CompanyName = Nz(objForm!CompanyName, "")
'        .JobTitle = Nz(objForm!ContactTitle, "")
        .BusinessAddress = Nz(objForm!CompanyAddress1, "")
        .BusinessAddressCity = Nz(objForm!CompanyAddress2, "")
        .BusinessAddressState = Nz(objForm!CompanyAddress3, "")
        .BusinessAddressPostalCode = Nz(objForm!CompanyPostalCode, "")
        .BusinessAddressCountry = Nz(objForm!Country, "")
        .BusinessTelephoneNumber = Nz(objForm!ContactWorkPhone1, "")
        .BusinessFaxNumber = Nz(objForm!ContactFax1, "")
        .CustomerID = Nz(objForm!EnquiryID, "")
        .Save
        Set prpUserProp = .UserProperties.Add("CustomEntryID", olText)
        prpUserProp.Value = .CustomEntryID
    End With
    
    DoCmd.Beep
    AddContact = True

AddNew_Bye:
    
    Exit Function

AddNew_Err:
    
    If Err = 91 Then
        MsgBox "This procedure is not available when working off-line."
    Else
        MsgBox Error$, , ""
    End If
    
    AddContact = False
    Resume AddNew_Bye

End Function

Hope you can work it from here!

Regards

Tony