Saving Outlook Attachments - but not the inline images

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
LVL 1
dwe0608Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewCommented:
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
0
Bill PrewCommented:
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
0
Alexei KuznetsovMicrosoft Outlook MVPCommented:
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" .../>.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

dwe0608Author 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
0
dwe0608Author 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
0
Alexei KuznetsovMicrosoft Outlook MVPCommented:
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.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
dwe0608Author Commented:
Thanks guys, a combination of suggestions worked ...:-)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.