Saving Outlook Attachments - but not the inline images

dwe0608
dwe0608 used Ask the Experts™
on
Hi Guys,

Looking for some assistance in avoiding saving inline images (images which show in an email as opposed to those which are attached).

I am using the following code for saving the attachments to an email and it works fine - but includes ALL attachments, including inline images. How can I avoid that?

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem, strFolderPath As String)
    Dim oAttachment As Outlook.attachment
    Dim sSaveFolder As String
    Dim fso As New Scripting.FileSystemObject
    Dim bName As String
    Dim sSaveFolder As String
    
    'Checking that path ends in \
    If Right(strFolderPath, 1) = "\" Then
        ' fall through
    Else:
        strFolderPath = strFolderPath & "\"
    End If
    
    sSaveFolder = strFolderPath
    
    For Each oAttachment In MItem.Attachments
        ' change the file name with the index
        'Debug.Print "DisplayName: " & oAttachment.DisplayName
        'Debug.Print "FileName: " & oAttachment.FileName
        'Debug.Print "Pathname: " & oAttachment.PathName
        ' get the filename (no extension)
        bName = fso.GetBaseName(oAttachment.DisplayName)
        ' rename the file with no extension using the index as the order
        ' to be merged at a future date
        bName = oAttachment.Index & "-" & bName
        ' put the extension back on
        bName = bName & "." & fso.GetExtensionName(oAttachment.DisplayName)
        ' save the file with the new name
        oAttachment.SaveAsFile sSaveFolder & bName
    Next
    
End Sub

Open in new window


Many thanks

DWE
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewIT / Software Engineering Consultant
Top Expert 2016

Commented:
Try filtering them out by attachment type.

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem, strFolderPath As String)
    Dim oAttachment As Outlook.attachment
    Dim sSaveFolder As String
    Dim fso As New Scripting.FileSystemObject
    Dim bName As String
    Dim sSaveFolder As String
    
    'Checking that path ends in \
    If Right(strFolderPath, 1) = "\" Then
        ' fall through
    Else:
        strFolderPath = strFolderPath & "\"
    End If
    
    sSaveFolder = strFolderPath
    
    For Each oAttachment In MItem.Attachments
        If oAttachment.Type <> olEmbeddeditem Then
            ' change the file name with the index
            'Debug.Print "DisplayName: " & oAttachment.DisplayName
            'Debug.Print "FileName: " & oAttachment.FileName
            'Debug.Print "Pathname: " & oAttachment.PathName
            ' get the filename (no extension)
            bName = fso.GetBaseName(oAttachment.DisplayName)
            ' rename the file with no extension using the index as the order
            ' to be merged at a future date
            bName = oAttachment.Index & "-" & bName
            ' put the extension back on
            bName = bName & "." & fso.GetExtensionName(oAttachment.DisplayName)
            ' save the file with the new name
            oAttachment.SaveAsFile sSaveFolder & bName
        End If
    Next
    
End Sub

Open in new window


»bp
Bill PrewIT / Software Engineering Consultant
Top Expert 2016
Commented:
It that doesn't work then you can try:

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem, strFolderPath As String)
    Dim oAttachment As Outlook.attachment
    Dim sSaveFolder As String
    Dim fso As New Scripting.FileSystemObject
    Dim bName As String
    Dim sSaveFolder As String
    
    'Checking that path ends in \
    If Right(strFolderPath, 1) = "\" Then
        ' fall through
    Else:
        strFolderPath = strFolderPath & "\"
    End If
    
    sSaveFolder = strFolderPath
    
    For Each oAttachment In MItem.Attachments
        If oAttachment.Fields(&H3712001E) = "" Then
            ' change the file name with the index
            'Debug.Print "DisplayName: " & oAttachment.DisplayName
            'Debug.Print "FileName: " & oAttachment.FileName
            'Debug.Print "Pathname: " & oAttachment.PathName
            ' get the filename (no extension)
            bName = fso.GetBaseName(oAttachment.DisplayName)
            ' rename the file with no extension using the index as the order
            ' to be merged at a future date
            bName = oAttachment.Index & "-" & bName
            ' put the extension back on
            bName = bName & "." & fso.GetExtensionName(oAttachment.DisplayName)
            ' save the file with the new name
            oAttachment.SaveAsFile sSaveFolder & bName
        End If
    Next
    
End Sub

Open in new window


»bp
Alexei KuznetsovMicrosoft Outlook MVP
Commented:
First of all, inline images are not of olEmbeddeditem type. They're just simple olByValue attachments. They may or may not have the ATT_MHTML_REF (value 0x4) in PR_ATTACH_FLAGS (proptag 0x37140003). It also may be or may not be PR_ATTACHMENT_HIDDEN (proptag 0x7FFE000B).

In general, to be 100% sure, you need to take the PR_ATTACH_CONTENT_ID attachment property (proptag 0x3712001F) and search in MItem.HTMLBody for <img ... src="cid:PR_ATTACH_CONTENT_ID" .../>.
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
Hi Bill ... thanks for the help so far ... can you explain to me the difference between the two coded solutions you have provided ... ie oAttachment.Fields(&H3712001E) = "" and oAttachment.Type <> olEmbeddeditem ...

MTIA

DWE

Author

Commented:
Hi Alexei ... thanks for the input ... how would you incorporate your suggestion into the code ... currently I am using a small function which is working to an extent ...

Public Function IsHiddenAttachment(olkAtt As Outlook.attachment) As Boolean
    ' Purpose: Determines if an attachment is a hidden attachment.
    'Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E" - original
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B" - altered
    Dim olkPA As Outlook.PropertyAccessor, varTemp As Variant
    On Error Resume Next
    Set olkPA = olkAtt.PropertyAccessor
    varTemp = olkPA.GetProperty(PR_ATTACH_CONTENT_ID)
    IsHiddenAttachment = (Trim(varTemp) <> "")
    'Debug.Print varTemp
    On Error GoTo 0
    Set olkPA = Nothing
End Function

Open in new window


MTIA

DWE
Microsoft Outlook MVP
Commented:
In your first SaveAttachmentsToDisk macro, you need to get the PR_ATTACH_CONTENT_ID property (say, to "cid" variable) for each of the attachments and do something like this:
If InStr(MItem.HTMLBody, "cid:" & cid) > 0 Then
' this is inline attachment

Open in new window

Of course, the snipped above is not optimized at all, just to get the idea that inline images in HTML body look like <img src="cid:..."/>. In order to always get the correct results, you need to perform the case-insensitive search in HTMLBody. Also, ideally you need to check that cid:... in inside the <img>'s "src" attribute.

Author

Commented:
Thanks guys, a combination of suggestions worked ...:-)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial