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


    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.

                '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 & ""
                    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

    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!

On line you have If
objMsg.BodyFormat olFormatHTML Then

when it should be If objMsg.BodyFormat = olFormatHTML Then

Also, if there is nothing being passed into the SaveAttachments_Parameter function, you probably have no emails selected. Once I add the = to the code your code ran just fine.

This article has been dead for over six months. Start a new discussion instead.