Jedrei over at outlookforums.com wanted to send all of the files in a folder as email attachments, one attachment per message.
The following macro attaches one file to an email message and sends it, then sends the next file in the folder, repeating until all files are sent.
When it's finished, a dialog box tells you how many files were sent. It also lists the file names in the Immediate window, if you want to review and confirm each file was processed and sent.
To use this macro, open the VBA editor, add a new module and paste the code into it. Change fldName to use the correct path then run the macro.
If you need a record of the files sent, press Ctrl+G to open the Immediate window in the VBA Editor to view the list created by Debug.Print fName.
Dim fldName As String Sub SendFilesbyEmail() ' Fromhttp://slipstick.me/njpnx Dim sFName As String i = 0 fldName = "C:\Users\Diane\" sFName = Dir(fldName) Do While Len(sFName) > 0 Call SendasAttachment(sFName) sFName = Dir i = i + 1 Debug.Print fName Loop MsgBox i & " files were sent" End Sub Function SendasAttachment(fName As String) Dim olApp As Outlook.Application Dim olMsg As Outlook.MailItem Dim olAtt As Outlook.Attachments Set olApp = Outlook.Application Set olMsg = olApp.CreateItem(0) ' email Set olAtt = olMsg.Attachments ' attach file olAtt.Add (fldName & fName) ' send message With olMsg .Subject = "Here's that file you wanted" .To = "alias@domain.com" .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached " & fName & " as you requested." .Send End With End Function
Send all attachments in one message
When you want to send all attachments that are in a folder, you'll need to loop through the attachments in the function to add them to one message. The following example offers two options: add all items in the folder or add only certain file types to the message.
Sub SendFilesbyEmail() Call SendFiles("C:\Users\diane\Test\") ' use one line per file type 'Call SendFiles("C:\Users\diane\Test\", "*.docx") 'Call SendFiles("C:\Users\diane\Test\", "*.txt") End Sub Function SendFiles(fldName As String, Optional FileType As String = "*.*") Dim fName As String Dim sAttName As String Dim olApp As Outlook.Application Dim olMsg As Outlook.MailItem Dim olAtt As Outlook.Attachments Set olApp = Outlook.Application Set olMsg = olApp.CreateItem(0) ' email Set olAtt = olMsg.Attachments ' to send all fName = Dir(fldName) 'to send only certain extensions 'fName = Dir(fldName & FileType) Do While Len(fName) > 0 olAtt.Add fldName & fName sAttName = fName & "<br /> " & sAttName Debug.Print fName fName = Dir Loop ' send message With olMsg .Subject = "Here's that file you wanted" .To = "alias@domain.com" .HTMLBody = "Hi " & olMsg.To & ", <br /><br /> I have attached <br /> " & sAttName & "as you requested." .Display End With End Function
Attach files beginning with specific characters
When you want to include only attachments with filenames that begin with certain characters, you'll need to filter the filenames using an If statement.
' place at the top with other Dims Dim strName As String strName = InputBox("Enter first 4 characters of filename") Do While Len(fName) > 0 If Left(fName, 4) = strName Then olAtt.Add fldName & fName sAttName = fName & "<br />" & sAttName End If fName = Dir Loop
Attach Only New Files
This macro is a variation of the macro at Create a New Message using an HTML File or Stationery and attaches the newer files in the folder to individual messages.
This uses late binding to call the FileScripting object so we can avoid setting a reference to the scripting object model.
Sub SendNewestFiles() Dim objMail As Outlook.MailItem Dim fso As Object 'Scripting.FileSystemObject Dim strFile As String Dim fsoFile 'As Scripting.File Dim fsoFldr 'As Scripting.Folder Dim dtNew As Date, sNew As String Set fso = CreateObject("Scripting.FileSystemObject") ' path to folder strFile = "C:\Users\Diane Poremsky\Pictures\" Set fsoFldr = fso.GetFolder(strFile) dtNew = Now - 0.25 ' 6 hours ago For Each fsoFile In fsoFldr.Files ' if date created is less than 6 hours ago ' can use .DateLastModified If fsoFile.DateCreated > dtNew Then sNew = fsoFile.Path Set objMail = Application.CreateItem(olMailItem) With objMail .To = "email@address.com" .BodyFormat = olFormatPlain .Attachments.Add sNew .Display ' .send End With End If Next fsoFile End Sub
Send all files in a folder
Just another macro to send all files in a folder in individual messages.
Sub SendNewestFiles() Dim objMail As Outlook.MailItem Dim fldName As String Dim sName As String fldName = "C:\Users\Diane\Pictures\" i = 0 sName = Dir(fldName) Do While Len(sName) > 0 Set objMail = Application.CreateItem(olMailItem) With objMail .To = "email@address.com" .BodyFormat = olFormatPlain .Attachments.Add (fldName & sName) .Display ' .send End With sName = Dir i = i + 1 Loop End Sub
With a little rearranging, you can use this to send all files in one messages:
Set objMail = Application.CreateItem(olMailItem) i = 0 sName = Dir(fldName) Do While Len(sName) > 0 objMail.Attachments.Add (fldName & sName) sName = Dir i = i + 1 Loop With objMail .To = "email@address.com" .BodyFormat = olFormatPlain .Display ' .send End With
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, itâs at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
Diane,
I read later last night where someone else had success by making a copy and renaming it slightly. So I tired that and it worked.
I appreciate your quick response, thank you!
Diane,
I have used the send all files in a folder in individual messages for years until recently we were upgraded to office 365.
Now I get a complie error: Object library feature not supported
Do you know how would I change object library within the macro to work with office 365?
I have attached a screenshot of the error, thanks!
You're running the macro from Outlook? It should work - its failing on the object module, which is referenced in Outlook. If you are running it from another app, you need to set a reference for the Outlook object library.
I guess if I'd look closer, I'd see you are running it in Outlook. :) I just tested it in my Office 365 and it worked.
Regarding "Attach Only New Files"
How to attach all new files which are in two or three different folder in single email?
Hello,
This is great! Thank you! and I would know how to delete all files from the folder after I sent out?
Thanks
Vincent
Hello Diane,
I have around 300 emails as .msg attachments in a folder and just need to send (forward) them repeatedly to a mailbox for some testing, so looking for a code which will open the .msg attachment and forward that to a specified mail address. Kindly assist.
hey, thanks for the coding and it works very well for me.
wanted to know if i can add the file name as the subject but without file extension?
right now have use ".Subject = fName" but i get file extension also like "Testing.pdf"
Hi Diane,
can i get a read receipt once the recipient opens the attachment in outlook.
Just on opening the attachment, no. The receipts are sent when the email message is marked read or deleted.
Thanks for your response.
I do have the code to ask the recipient once the email read. but it shows the pop-up option to click 'yes' or 'no' button to the user.
can there be any codes which send me a receipt by default, once email read?
No question asked to user to chose either yes or no.
This macros appears to work because I am getting the message box, but it's actually not sending them out and saying 0 files sent. I updated the folder and email address. what else could I be doing incorrect? Also, this should be pasted to Outlook's VBA correct and not excel?
Yes, these are outlook macros. you can step though the macro and check each variable to see if its picking up the values.
Which macro are you using?