Now, this code was intended to suit my needs, but hopefully I've added enough comments to allow you to easily tweak it to fit your specific needs. So I would like to share with you what I use to email my Excel workbooks and worksheets as attachments. Having to type this out every time can be a bit annoying. I also like to add some sort of message in the email such as " Please see attached" or " Attached is your requested data". I can't tell you how many times I've attached a file named "Book1.xlsx" to someone. This annoyance inspired me to create a couple of VBA macros allowing me to add a little more functionality to Microsoft's Email As Attachment idea.įor one, I hate not being able to name the attached file. The only thing I dislike about this built-in feature is the lack of customization as I find myself repeatedly making the same changes over and over again.
It's great for quickly sending one-off data requests to someone throughout the day. I absolutely love using the Email As Attachment functionality provided by Excel. SaveAsFile ( outputDir + outputFile ) AttTotal = AttTotal + 1 End If nextitem : Next End If Next earlyexit : 'Clean up Set Sel = Nothing Set Exp = Nothing Set App = Nothing Set fso = Nothing 'Let user know we are done Dim doneMsg As String doneMsg = "Completed saving " + Format $ ( AttTotal, "#,0" ) + " attachments in " + Format $ ( MsgTotal, "#,0" ) + " Messages." MsgBox doneMsg, vbOKOnly, "Save Attachments" Exit Sub ErrorHandler : Dim errMsg As String errMsg = "An error has occurred. fileExists ( outputDir + outputFile ) Loop 'Save it to disk if the file does not exist If fileExists = False Then att. That will be a flag not to write the file Exit Do End If fileExists = fso. Please enter a new name, or hit cancel to skip this one file.", "File Exists", outputFile ) 'If user hit cancel If outputFile = "" Then 'Exit leaving fileexists true. fileExists ( outputDir + outputFile ) Do While fileExists = True outputFile = InputBox ( "The file " + outputFile _ + " already exists in the destination directory of " _ + outputDir + ". That will be a flag not to write the file GoTo nextitem End If 'Give an option to exit If outputFile = "cancel" Then GoTo earlyexit End If fileExists = fso. SenderName & " )" outputFile = InputBox ( strSubject & vbCrLf & vbCrLf & "Please enter a new name if needed, or hit cancel to skip this one file.give name cancel to exit", "File Name", outputFile ) If outputFile = "" Then 'Exit leaving fileexists true. FileName 'Forcing to give me option to choose file name Let strSubject = Sel. Count 'Get the attachment Dim att As Attachment Set att = Sel. Count > 0 Then MsgTotal = MsgTotal + 1 'For each attachment on the message.
Exiting SaveAttachments.", vbCritical, "SaveAttachments" Exit Sub End If 'Loop thru each selected item in the inbox For cnt = 1 To Sel. Selection Set fso = New FileSystemObject outputDir = GetOutputDirectory () If outputDir = "" Then MsgBox "You must pick an directory to save your files to. Selection Dim AttachmentCnt As Integer Dim AttTotal As Integer Dim MsgTotal As Integer Dim outputDir As String Dim outputFile As String Dim fileExists As Boolean Dim cnt As Integer Dim strSubject As String 'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL) Dim fso As FileSystemObject Set Exp = App. 'It does not have to be the inbox, simply any folder with e-mail messages Dim App As New Outlook. Public Sub SaveAttachments () 'Note, this assumes you are in the a folder with e-mail messages when you run it.
0 kommentar(er)
