By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
444,190 Members | 1,653 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 444,190 IT Pros & Developers. It's quick & easy.

How to send email with attachment & access Outlook address book

beacon
100+
P: 579
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:
Expand|Select|Wrap|Line Numbers
  1. Private Sub Command43_Click()
  2.  
  3.     On Error GoTo err_Session_AddressBook
  4.  
  5.     Dim objOL As Outlook.Application
  6.     Dim oOutlook As Object
  7.     Dim oMail As Object
  8.     Dim objSession As MAPI.Session
  9.     Dim colCDORecips As Object
  10.     Dim strEmail As String
  11.  
  12.     On Error Resume Next
  13.  
  14.     Set objOL = GetObject(, "Outlook.Application")
  15.  
  16.     If Err.Number <> 0 Then
  17.         Set oOutlook = CreateObject("Outlook.Application")
  18.         Set oMail = oOutlook.CreateItem(olMailItem)
  19.         oMail.Display
  20.     End If
  21.  
  22.     Set objSession = New MAPI.Session
  23.     objSession.Logon "", "", False, False
  24.  
  25.     Set colCDORecips = objSession.AddressBook(, "Pick Names", , , 2, "To: ", "Cc: ")
  26.  
  27.     objSession.Logoff
  28.  
  29.     Set colCDORecips = Nothing
  30.     Set objSession = Nothing
  31.     Set objOL = Nothing
  32.     Set oOutlook = Nothing
  33.     Set oMail = Nothing
  34.  
  35. err_Session_AddressBook:
  36.     If (Err = 91) Then ' MAPI dlg-related function that sets an object
  37.         MsgBox "No recipients selected"
  38.     Else
  39.         'MsgBox "Unrecoverable Error:" & Err
  40.     End If
  41. End Sub
  42.  
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
Jul 28 '10 #1

✓ answered by 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):
Expand|Select|Wrap|Line Numbers
  1. Private Sub Command43_Click()
  2.  
  3.     Dim objOL As Outlook.Application
  4.     Dim oOutlook As Object
  5.     Dim oMail As Object
  6.     Dim objSession As MAPI.Session
  7.     Dim colCDORecips As Object
  8.  
  9.     On Error Resume Next
  10.  
  11.     Set objOL = GetObject(, "Outlook.Application")
  12.  
  13.     If Err.Number <> 0 Then
  14.         Set oOutlook = CreateObject("Outlook.Application")
  15.         Set oMail = oOutlook.CreateItem(olMailItem)
  16.     End If
  17.  
  18.     Set objSession = New MAPI.Session
  19.     objSession.Logon "", "", False, False
  20.  
  21.     Set colCDORecips = objSession.AddressBook(, "Pick Names", , True, 2, "To: ", "CC: ")
  22.  
  23.     If colCDORecips Is Nothing Then
  24.         Exit Sub
  25.     End If
  26.  
  27.     For Each col In colCDORecips
  28.         tmp = tmp & col & ";"
  29.     Next col
  30.  
  31.     strFileName = "C:\Temp\Contacts.snp"
  32.  
  33.     DoCmd.OutputTo acOutputReport, "Contacts", acFormatSNP, strFileName
  34.  
  35.     With oMail
  36.         .To = tmp
  37.         .Subject = "These two files"
  38.         .BodyFormat = olFormatHTML
  39.         .HTMLBody = "Please resolve the deficiencies in the attached report."
  40.         .Attachments.Add strFileName
  41.         .Send
  42.     End With
  43.  
  44.     objSession.Logoff
  45.  
  46.     'Cleanup
  47.     '---------------------------
  48.     Set colCDORecips = Nothing
  49.     Set objSession = Nothing
  50.     Set objOL = Nothing
  51.     Set oOutlook = Nothing
  52.     Set oMail = Nothing
  53.  
  54.     'Delete the file created by the SendObject method
  55.     '---------------------------------------------------
  56.     Set newFile = CreateObject("Scripting.FileSystemObject")
  57.     Set newFolder = newFile.GetFile(strFileName)
  58.     newFolder.Delete
  59.  
  60.     Exit Sub
  61.  
  62. err_Session_AddressBook:
  63.     If (Err = 91) Then ' MAPI dlg-related function that sets an object
  64.         MsgBox "No recipients selected"
  65.     Else
  66.         MsgBox "Unrecoverable Error:" & Err
  67.     End If
  68. End Sub
  69.  

Share this Question
Share on Google+
1 Reply


beacon
100+
P: 579
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):
Expand|Select|Wrap|Line Numbers
  1. Private Sub Command43_Click()
  2.  
  3.     Dim objOL As Outlook.Application
  4.     Dim oOutlook As Object
  5.     Dim oMail As Object
  6.     Dim objSession As MAPI.Session
  7.     Dim colCDORecips As Object
  8.  
  9.     On Error Resume Next
  10.  
  11.     Set objOL = GetObject(, "Outlook.Application")
  12.  
  13.     If Err.Number <> 0 Then
  14.         Set oOutlook = CreateObject("Outlook.Application")
  15.         Set oMail = oOutlook.CreateItem(olMailItem)
  16.     End If
  17.  
  18.     Set objSession = New MAPI.Session
  19.     objSession.Logon "", "", False, False
  20.  
  21.     Set colCDORecips = objSession.AddressBook(, "Pick Names", , True, 2, "To: ", "CC: ")
  22.  
  23.     If colCDORecips Is Nothing Then
  24.         Exit Sub
  25.     End If
  26.  
  27.     For Each col In colCDORecips
  28.         tmp = tmp & col & ";"
  29.     Next col
  30.  
  31.     strFileName = "C:\Temp\Contacts.snp"
  32.  
  33.     DoCmd.OutputTo acOutputReport, "Contacts", acFormatSNP, strFileName
  34.  
  35.     With oMail
  36.         .To = tmp
  37.         .Subject = "These two files"
  38.         .BodyFormat = olFormatHTML
  39.         .HTMLBody = "Please resolve the deficiencies in the attached report."
  40.         .Attachments.Add strFileName
  41.         .Send
  42.     End With
  43.  
  44.     objSession.Logoff
  45.  
  46.     'Cleanup
  47.     '---------------------------
  48.     Set colCDORecips = Nothing
  49.     Set objSession = Nothing
  50.     Set objOL = Nothing
  51.     Set oOutlook = Nothing
  52.     Set oMail = Nothing
  53.  
  54.     'Delete the file created by the SendObject method
  55.     '---------------------------------------------------
  56.     Set newFile = CreateObject("Scripting.FileSystemObject")
  57.     Set newFolder = newFile.GetFile(strFileName)
  58.     newFolder.Delete
  59.  
  60.     Exit Sub
  61.  
  62. err_Session_AddressBook:
  63.     If (Err = 91) Then ' MAPI dlg-related function that sets an object
  64.         MsgBox "No recipients selected"
  65.     Else
  66.         MsgBox "Unrecoverable Error:" & Err
  67.     End If
  68. End Sub
  69.  
Jul 30 '10 #2

Post your reply

Sign in to post your reply or Sign up for a free account.