Save attachments and send clean emails


September 28, 2008 – 5:35 pm by JP

    Do you ever need to forward attachments to someone else (maybe your boss), but don't want the ugliness of "FW: FW: re:" in the subject line? Why let others choose how your emails are going to appear -- here's an amalgam of code I've posted previously (mainly from Processing multiple emails) that does the following: You select a series of emails (or even just one email) with attachments, and the code saves all the attachments to a folder on your desktop, then re-attaches all of them to a single new email to which you can craft a new subject, and send it wherever you want.

    So when 10 people in your office forward you attachments in 10 different emails, and you need to forward all of the attachments on to the same place, this code can be used to combine them all into one email.

VBA:
  1. Sub SaveFilesAndSendCleanEmail()
  2. ' save attachments to desktop folder (create one if necessary),
  3. ' then email them out one by one
  4.  
  5. Dim Msg As Outlook.MailItem
  6. Dim NewMsg As Outlook.MailItem
  7. Dim MsgColl As Object
  8. Dim MsgAttach As Outlook.Attachments
  9. Dim NewMsgAttach As Outlook.Attachments
  10. Dim ThisAttach As Outlook.Attachment
  11. Dim i As Long
  12. Dim strMyDesktop As String
  13. Dim strDestinationFolder As String
  14. Dim strFileN As String
  15. Dim fso As Object
  16. Dim item As Object
  17.  
  18. On Error Resume Next
  19. Set MsgColl = ActiveExplorer.Selection
  20. On Error GoTo 0
  21.  
  22. If MsgColl Is Nothing Then
  23.   MsgBox "Nothing selected"
  24.   GoTo ExitProc
  25. End If
  26.  
  27. ' get path of user's desktop and build a string for the destination folder
  28. strMyDesktop = MyDesktopPath & "\"
  29. strDestinationFolder = strMyDesktop & "Saved Attachments\"
  30.  
  31. ' get a FileSystemObject reference
  32. Set fso = GetFSO
  33.  
  34. ' check if the folder exists, if not then create it to store the attachments
  35. If fso.FolderExists(strDestinationFolder) = False Then
  36.     MkDir strDestinationFolder
  37. End If
  38.  
  39. ' loop through each selected item and make sure they are all mailitems
  40. ' if so, then save each attachment from each message to the destination folder
  41. For Each item In MsgColl
  42.   If item.Class = olMail Then ' it's an email, not a post, note, meeting request, etc
  43.     Set Msg = item
  44.     Set MsgAttach = Msg.Attachments
  45.    
  46.     If MsgAttach.Count> 0 Then
  47.       For i = 1 To MsgAttach.Count
  48.         MsgAttach.item(i).SaveAsFile strDestinationFolder & MsgAttach.item(i).FileName
  49.       Next i
  50.     End If
  51.   End If
  52. Next item
  53.  
  54. ' Forward attachments to another email address
  55. ' first create the email, then loop through destination folder, adding attachments to the email and deleting them from the folder as we go
  56. Set NewMsg = CreateItem(olMailItem)
  57. Set NewMsgAttach = NewMsg.Attachments
  58.  
  59. strFileN = Dir(strDestinationFolder & "*.*")
  60.  
  61. Do While Len(strFileN)> 0
  62.   NewMsgAttach.Add strDestinationFolder & strFileN
  63.   Kill strDestinationFolder & strFileN
  64.   strFileN = Dir
  65. Loop
  66.  
  67. NewMsg.Display
  68.  
  69. ' clean up emails (optional)
  70. If MsgBox("Would you like to delete the selected emails now?", vbInformation + vbYesNo) = vbYes Then
  71.   For i = 1 To MsgColl.Count
  72.     Set Msg = MsgColl.item(i)
  73.     With Msg
  74.       .UnRead = False
  75.       .Delete
  76.     End With
  77.   Next i
  78. End If
  79.  
  80. If MsgBox("Delete destination folder that was created on your desktop?", vbInformation + vbYesNo) = vbYes Then
  81.   RmDir strDestinationFolder
  82. End If
  83.  
  84. ExitProc:
  85. Set Msg = Nothing
  86. Set MsgColl = Nothing
  87. Set MsgAttach = Nothing
  88. Set fso = Nothing
  89. Set NewMsg = Nothing
  90. Set NewMsgAttach = Nothing
  91. End Sub

    The first thing you'll need to do is select the message(s) with attachments that you want to combine into one email. The code sets an object reference to the selection and saves all of the attachments from each of them.

    We use an encapsulated function called MyDesktopPath, which I found in a newsgroup posting. The Windows Script Host Object Model has a SpecialFolders Method which can return the path to the end users' Desktop folder. This will let us determine the correct folder without any special or complicated programming. We'll create a temp folder called "Saved Attachments" which will store all of the attachments from all of the emails we selected.

VBA:
  1. Function MyDesktopPath() As String
  2. ' returns path to Desktop folder as a String
  3. ' from http://tinyurl.com/GetFolderPath
  4. Dim WSHShell As Object
  5.  
  6. Set WSHShell = CreateObject("WScript.Shell")
  7. MyDesktopPath = WSHShell.SpecialFolders("Desktop")
  8.  
  9. Set WSHShell = Nothing
  10. End Function

    We'll use the Scripting.FileSystemObject to check if the folder already exists. Here's the function that returns an object reference. It's fully encapsulated so you can just drop it into any project you need and it returns a reference to that object.

VBA:
  1. Function GetFSO() As Object
  2. ' returns a reference to the Scripting.FileSystemObject to the calling sub
  3. On Error Resume Next
  4.   Set GetFSO = GetObject(, "Scripting.FileSystemObject")
  5. On Error GoTo 0
  6.  
  7. If GetFSO Is Nothing Then
  8.   Set GetFSO = CreateObject("Scripting.FileSystemObject")
  9. End If
  10. End Function

    Then we'll use a For Each Loop, setting an object reference to each mailitem in turn. There's a loop-within-a-loop, where we loop through the attachments collection for each mailitem and save them to that temp folder mentioned earlier.

    In order to attach files to the newly created email from our desktop folder, a Do Loop is used to get successive filenames, and the Add Method of the Attachments Collection adds them to the message. At this point, you can do whatever you want with the email; I chose to use the Display Method to show the email, so I can type in the recipient(s), subject, etc. If you always send the attachments to the same place, you can pre-fill this information and use the Send Method instead.

Enjoy,
JP


Share and Enjoy:
  • StumbleUpon
  • Technorati
  • Digg
  • Google
  • del.icio.us
  • MisterWong

Print This Post Print This Post  |  Email This Post Email This Post  |  Permalink  |  Subscribe to this feed Subscribe now!

Filed Under: Outlook, VBA
Tags:

This post has 285 views since September 28, 2008 – 5:35 pm.

Post a Comment

To post VBA code in your comment, use [VBA] tags, like this: [VBA]Code goes here[/VBA].





Subscribe without commenting

Keep Reading:

Browse Posts:


« My Excel User Conference Experience || Blog Maintenance »