I was wondering if anyone could help me out with a problem I've had for a few days. This is a code snippet of a program I'm writing to move and delete email attachments from one or more selected emails. Everything works great except the program won't edit the body of the emails as written. When I interrogated in the editor, I found that the MailItems are empty upon initialization and after passed to the sub routine. Any idea why an email I know has text comes up with no body or HTMLBody in Outlook VBA? Thanks in advance.
Public Sub SaveAttachments() Dim objOL As Outlook.Application Dim pobjMsg As Outlook.MailItem 'Object Dim objSelection As Outlook.Selection ' Get the path to your My Documents folder strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) On Error Resume Next ' Instantiate an Outlook Application object. Set objOL = CreateObject("Outlook.Application") ' Get the collection of selected objects. Set objSelection = objOL.ActiveExplorer.Selection For Each pobjMsg In objSelection SaveAttachments_Parameter pobjMsg Next ExitSub: Set pobjMsg = Nothing Set objSelection = Nothing Set objOL = Nothing End Sub Public Sub SaveAttachments_Parameter(objMsg As MailItem) Dim objAttachments As Outlook.Attachments Dim i As Long Dim lngCount As Long Dim strFile As String Dim strFolderpath As String Dim strDeletedFiles As String ' Get the path to your My Documents folder strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16) On Error Resume Next ' Set the Attachment folder. strFolderpath = strFolderpath & "\OLAttachments\" ' Get the Attachments collection of the item. Set objAttachments = objMsg.Attachments lngCount = objAttachments.Count If lngCount > 0 Then ' We need to use a count down loop for removing items ' from a collection. Otherwise, the loop counter gets ' confused and only every other item is removed. For i = lngCount To 1 Step -1 ' Save attachment before deleting from item. ' Get the file name. strFile = objAttachments.Item(i).FileName ' Combine with the path to the Temp folder. strFile = strFolderpath & strFile ' Save the attachment as a file. objAttachments.Item(i).SaveAsFile strFile ' Delete the attachment. 'objAttachments.Item(i).Delete 'write the save as path to a string to add to the message 'check for html and use html tags in link If objMsg.BodyFormat olFormatHTML Then strDeletedFiles = strDeletedFiles & vbCrLf & "" Else strDeletedFiles = strDeletedFiles & "" & "<a href='//" & _ strFile & "'>" & strFile & "</a>" End If Next i End If ' Adds the filename string to the message body and save it [COMMENTED AS THIS FUNCTION WAS NOT DESIRED] ' Check for HTML body ' If objMsg.BodyFormat olFormatHTML Then ' objMsg.Body = objMsg.Body & vbCrLf & _ ' "The file(s) were saved to " & strDeletedFiles ' Else ' objMsg.HTMLBody = objMsg.HTMLBody & "" & _ ' "The file(s) were saved to " & strDeletedFiles & "" ' End If objMsg.Save ExitSub: Set objAttachments = Nothing Set objMsg = Nothing Set objOL = Nothing End Sub
This code was originally written on http://www.outlook-tips.net/code-samples/save-and-delete-attachments/2/. Thanks for your help!