Automatically attach a file to all outgoing messages

Someone on Outlook Code asked about automatically attaching a file to new messages. You could do this two ways:

1. Create a new message programmatically and attach the file.
2. Use the ItemSend Event to attach the file to all outgoing messages.

Here I'll demonstrate the first way, since I've already posted code for the second way. (see Attach files to an Outlook email using VBA)

Sub NewMsgWithAttachment()

Const ATTACHMT As String = "C:\My Files\Attachment.pdf"

Dim olApp As Outlook.Application
Dim Msg As Outlook.MailItem

Set olApp = Outlook.Application
Set Msg = olApp.CreateItem(olMailItem)

With Msg
  .Attachments.Add ATTACHMT
  .Display
End With

End Sub

Run this macro whenever you want to send an email with the named attachment. Or if you need to send different attachments at different times, turn the sub into a function and pass it the filename:

Function NewMsgWithAttachment(fileName As String)

Dim olApp As Outlook.Application
Dim Msg As Outlook.MailItem

Set olApp = Outlook.Application
Set Msg = olApp.CreateItem(olMailItem)

With Msg
  .Attachments.Add fileName
  .Display
End With

End Sub

Then set up different subs with each filename and call each one as needed:

Sub SendFile1()
  Call NewMsgWithAttachment("C:\File1.xls")
End Sub

Sub SendFile2()
  Call NewMsgWithAttachment("C:\File2.xls")
End Sub

Sub SendFile3()
  Call NewMsgWithAttachment("C:\File3.xls")
End Sub