How to send email with attachment & access Outlook address book

[beacon]

Hi everybody,

I'm sure that everyone cringes when they see "email" in the subject for posts in the forum, but I'm hoping that what I'm trying to do is different enough to present a challenge instead of an aneurysm. =)

I'm creating a form with a list box of values that, when selected, will create a filter for a report. On this same form, I want to add a command button that will allow the user to send an email with the report, based on the filter criteria, as an attachment. To make things a little bit more interesting, I would like to display the Outlook address book to the user to select the email addresses to send the report (I can't rely on the users to accurately enter email addresses and I don't want to import the contacts because my database is already projected to be extremely large).

I did some homework and found a way to display the Outlook address book using CDO, but once it's displayed I don't know how to capture the email addresses from the alias and then create the email, not to mention have the email automatically send without requiring the user to click 'Send' in Outlook.

Here's the code I "borrowed" from another site:

Private Sub Command43_Click()
 
    On Error GoTo err_Session_AddressBook
 
    Dim objOL As Outlook.Application
    Dim oOutlook As Object
    Dim oMail As Object
    Dim objSession As MAPI.Session
    Dim colCDORecips As Object
    Dim strEmail As String
 
    On Error Resume Next
 
    Set objOL = GetObject(, "Outlook.Application")
 
    If Err.Number <> 0 Then
        Set oOutlook = CreateObject("Outlook.Application")
        Set oMail = oOutlook.CreateItem(olMailItem)
        oMail.Display
    End If
 
    Set objSession = New MAPI.Session
    objSession.Logon "", "", False, False
 
    Set colCDORecips = objSession.AddressBook(, "Pick Names", , , 2, "To: ", "Cc: ")
 
    objSession.Logoff
 
    Set colCDORecips = Nothing
    Set objSession = Nothing
    Set objOL = Nothing
    Set oOutlook = Nothing
    Set oMail = Nothing
 
err_Session_AddressBook:
    If (Err = 91) Then ' MAPI dlg-related function that sets an object
        MsgBox "No recipients selected"
    Else
        'MsgBox "Unrecoverable Error:" & Err
    End If
End Sub
 

Just for the record, I'm completely content using whatever method (including CDO) so long as the email will be sent automatically without the user having to click 'Send', the email will be sent to the users captured from the Outlook address book automation, and the report can be automatically attached without having to save the report to a network folder first.

Thanks,
beacon

[beacon]

Nevermind, I was able to resolve this issue.

For those that are interested, here's the code I used (I wasn't able to resolve the Outlook security, but you can't win them all):

Private Sub Command43_Click()
 
    Dim objOL As Outlook.Application
    Dim oOutlook As Object
    Dim oMail As Object
    Dim objSession As MAPI.Session
    Dim colCDORecips As Object
 
    On Error Resume Next
 
    Set objOL = GetObject(, "Outlook.Application")
 
    If Err.Number <> 0 Then
        Set oOutlook = CreateObject("Outlook.Application")
        Set oMail = oOutlook.CreateItem(olMailItem)
    End If
 
    Set objSession = New MAPI.Session
    objSession.Logon "", "", False, False
 
    Set colCDORecips = objSession.AddressBook(, "Pick Names", , True, 2, "To: ", "CC: ")
 
    If colCDORecips Is Nothing Then
        Exit Sub
    End If
 
    For Each col In colCDORecips
        tmp = tmp & col & ";"
    Next col
 
    strFileName = "C:\Temp\Contacts.snp"
 
    DoCmd.OutputTo acOutputReport, "Contacts", acFormatSNP, strFileName
 
    With oMail
        .To = tmp
        .Subject = "These two files"
        .BodyFormat = olFormatHTML
        .HTMLBody = "Please resolve the deficiencies in the attached report."
        .Attachments.Add strFileName
        .Send
    End With
 
    objSession.Logoff
 
    'Cleanup
    '---------------------------
    Set colCDORecips = Nothing
    Set objSession = Nothing
    Set objOL = Nothing
    Set oOutlook = Nothing
    Set oMail = Nothing
 
    'Delete the file created by the SendObject method
    '---------------------------------------------------
    Set newFile = CreateObject("Scripting.FileSystemObject")
    Set newFolder = newFile.GetFile(strFileName)
    newFolder.Delete
 
    Exit Sub
 
err_Session_AddressBook:
    If (Err = 91) Then ' MAPI dlg-related function that sets an object
        MsgBox "No recipients selected"
    Else
        MsgBox "Unrecoverable Error:" & Err
    End If
End Sub