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!