VBA – Loop through files and attach each one to a new email

by

The situation that was brought to me was that a folder existed on a desktop that had approximately 100 pdf files.  These files all needed to be emailed out as monthly billing statements.  These were only the ones that were not billable through EDI or some other method.

Here are the rules:

  • For every pdf file in the folder, create a new email with a default subject and body
  • Do not display the new mail items on the screen – save them to the drafts folder
  • Send as the Accounts Receivable exchange account, not the person running this script
  • Do not add the To address yet (this will come later as a version 2 when the data is available)
  • Do not automatically send (this will come later as a version 2 when the data for ‘To’ is available)

The end result was this simple script that took 15 minutes to create and saved about an hour a month from a senior accountant.  The version two script when the ‘To’ data is available should save another hour, maybe two more.

Sub EachItemInFolderToNewEmail()
Dim StrFile As String, StrPath As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")

'define where we look for our folder full of pdf files
StrPath = "F:\07052018\Statements\Send Statements\"
StrFile = Dir("F:\07052018\Statements\Send Statements\*.pdf")

'loop that directory
Do While Len(StrFile) > 0

'create a new email window
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook 'apply to each new email window
  .BodyFormat = olFormatRichText
  .SentOnBehalfOfName = "user@example.com" 'send as
  '.To = "test@test.org"
  .Subject = "Billing statement attached"
  .HTMLBody = "Please open the attached file to view your Statement.<br><br>" & _
  "<h3>Accounts Receivable</h3><b>Billing Department</b><br>Office: 518-555-6393<br>example.com "
  .Attachments.Add StrPath + StrFile
  '.Display
  '.Send
  .Save 'save as draft
End With
StrFile = Dir
Loop

'message box when the loop finishes
MsgBox "Done!", vbOKOnly
End Sub

This met all of our requirements and the user ended up with more than 100 emails in the draft folder, but that’s exactly what they wanted.  Each email eventually got human double checked, addressed, and sent.  I’ll update if version 2 fully automates this process.

I left a few items in there commented out that might be helpful for troubleshooting or modifications.  Feel free to modify this script for your needs.