Okay, so here's how I would approach this:
Step 1: Set up the table of email addresses
- Set up a list with the following headers: Page Number, Name, Email Address
- Fill the list in with the appropriate data (DO NOT leave a blank row between your headers and your data!)
- Click in that list, go to Home-->Format As Table (It should find the entire table and have the "My table has headers" box checked already)
- Click OK
- Go to TableTools --> Design
- On the far left, change the Table Name to: tblEmails
Step 2: Download an install my Class module for email:
- You can find it here
- Follow the instructions there to install it (but don't worry about writing any code just yet.)
Step 3: Coding the mail routine
- Insert a new Module into your project and add the following code:
Code:
Private Sub EmailViaOutlook(sTo As String, sAttach As String)
'Create the email object
Dim oEmail As New clsOutlookEmail
With oEmail
'Add a recipient
.AddToRecipient = sto
'Set the subject
.Subject = "The file you requested"
'Set the body
.Body = "Here is the file you requested."
'Add an attachment
.AttachFile = sAttach
'Preview the email (or use .Send to send it)
.Preview
End With
'Release the email object
Set oEmail = Nothing
End Sub
Step 4: Code the routine to generate and mail the PDF
- In the module you used above, insert the following code:
Code:
Public Sub GenerateEmails()
Dim cl As Range
Dim sTempPath As String
Dim sFileName As String
Dim sReportSheet As String
Dim sEmailSheet As String
'Define the names of your worksheets here
sEmailSheet = "Emails" '<-- The worksheet that holds your email table
sReportSheet = "Reports" '<-- The workshee that holds your reports
sTempPath = "C:\Users\" & Environ("Username") & "\Desktop\"
For Each cl In Worksheets(sEmailSheet).Range("tblEmails[Page Number]")
'Record the output name for the file
sFileName = cl.Offset(0, 1)
'Remove any existing instance of the file
On Error Resume Next
Kill sTempPath & sFileName & ".pdf"
On Error GoTo 0
'Export a temporary copy of the file
Worksheets(sReportSheet).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sTempPath & sFileName & ".pdf", _
From:=cl.Value, To:=cl.Value
'Email the file
Call EmailViaOutlook(cl.Offset(0, 2), sTempPath & sFileName & ".pdf")
'Remove the temp file
On Error Resume Next
Kill sTempPath & sFileName & ".pdf"
On Error GoTo 0
Next cl
End Sub
Now, you'll need to make two changes to make this work for you:
- Update the sEmailSheet = "Emails" line, replacing EMails with the name of the worksheet that holds your email table (leave the quotes in place though)
- Update the sReportSheet = "Reports" line, replacing Reports with the name of the worksheet that holds the reports you want to email (again, leave the quotes in place)
Step 5: Test It
- Close the VBE
- Save the Workbook
- Open Outlook (It will work if Outlook is closed, it just takes longer)
- Go back to Excel and Press Alt+F8
- Run "GenerateEmails"
At this point it may take a minute, but you should see Outlook draft messages come up for you, addressed to the correct person, with the correct attachment.
You have the option of tossing them, or clicking send on each one. If you would rather send each automatically, just change the .Preview in the EmailViaOutlook routine to .Send and you should be good to go.
I've attached a sample workbook where everything is hooked up for you to look at.
Bookmarks