?
Solved

Remove Outlook Attachments, But Not Inline Images

Posted on 2009-12-16
18
Medium Priority
?
1,828 Views
Last Modified: 2012-05-08
In order to reduce PST size, I've written a routine that removes attachments from a given e-mail. asks me to save them, and inserts a list of removed attachments below the body text. This is available through a button in an open e-mail and is triggered whenever I've sent an e-mail.

It works perfectly, except for the fact that it *also* removes images embedded in the e-mail body (HTML format). It seems that I cannot distinguish through code between attachments and attachments posing as inline images. The FileName and DisplayName properties are no help, nor is the Position property, which gives me the position of the attachments relative to the Body, not the HTMLBody (or I could simply look for an IMG tag at the Position). The IMG tags in the HTMLBody refer to a CID code, not to the file name, so I can't use that either to determine which attachments are actually inline pictures.

I've considered the following extremely fault sensistive and cumbersome solution:
- Check each attachment's Position
- Look in the Body before the Position and register what text, if any, is there
- Look for that text in the HTMLBody and check if the text is followed (closely) by an IMG tag.

This might work, kinda, but seems rather complicated for something that should be simple.

Ideas?
0
Comment
Question by:FlorisMK
  • 6
  • 6
  • 4
  • +1
18 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26060748
Hello FlorisMK,

I believe that for example via redemption the nature of the attachments as embeded etc can be identified ... however in a similar position i.e. seeking to redcuce PST sizes I looked at the attachment size and if over x then I saved it to the HD and included it as a link in the email as well.

Regards,

chris_bottomley
0
 
LVL 5

Expert Comment

by:Khalid Mehmood Awan
ID: 26060980
I guess, images within email body are treated as attachment when they are saved to PST.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 26061030
Hi, FlorisMK.

What version of Outlook are you using?
0
NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

 
LVL 2

Author Comment

by:FlorisMK
ID: 26061494
Thanks, chris - looking at size doesn't solve the embedded image issue though, except for the advantage that the picture can be easily retrieved through the link you create. Using Redemption is not an option in our TS environment.

khalid, yes, that is true and lies at the root of the problem.

BlueDevilFan: I'm in Outlook 2003, but have the same problem in 2007 and had the same problem in 2000, I think.
0
 
LVL 5

Expert Comment

by:Khalid Mehmood Awan
ID: 26061572
to add more, inline images when saved as attachment usually have Image001.jpg like format ;-)

That can help you do the trick, you can skip deleting any such attachment...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26061575
AGreed

I have been working on this in the meantime ... as yet I am getting a failure with 1 email though thousands work ok so see how it goes for you.  Basically it excludes OLE files.

Chris
Sub ini_attachStrip()
Dim mai As mailitem
Dim saveAttFolder As String
Dim fldr As Object
Dim myPSTs As Object
    
    saveAttFolder = Environ("userprofile") & "\my documents\mailattachments"
    md saveAttFolder, True
    For Each myPSTs In Application.Session.Folders
        If myPSTs.Name <> "Public Folders" Then
            For Each fldr In myPSTs.Folders
                attachStrip fldr, saveAttFolder
            Next
        End If
    Next
 
End Sub
 
Function md(dosPath As String, Optional createFolders As Boolean)
Dim FSO As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
    
    md = True
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not FSO.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If
 
        For fldrIndex = 1 To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not FSO.FolderExists(rootdir) Then
                If createFolders Then
                    FSO.CreateFolder rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function
Sub attachStrip(fldr As Object, saveFolder As String)
Dim att As Attachment
Dim DOSFile As String
Dim intAttCount As Integer
Dim lngMailCount As Long
Dim saveAttAs(1 To 3) As String
Dim verNumber As Integer
Dim obj As Object
Dim mai As mailitem
Dim subFolder As Object
Dim FSO As Object
Const sizelimit As Long = 5196
' Secure email Issue see : http://support.microsoft.com/kb/896594
 
    If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject")
    If fldr.DefaultItemType <> olMailItem Then Exit Sub
    For lngMailCount = fldr.items.Count To 1 Step -1
        Set obj = fldr.items(lngMailCount)
        If obj.Class = olMail Then
            Err.Clear
            On Error Resume Next
            Set mai = obj
            On Error GoTo 0
            If Err.Number = 13 Then GoTo assumeEncrypted
            If mai Is Nothing Then GoTo maiIsNothing
            Err.Clear
            For intAttCount = mai.Attachments.Count To 1 Step -1
                Set att = mai.Attachments(intAttCount)
                If att.Type <> olOLE Then
                    verNumber = 1
                    saveAttAs(1) = saveFolder
                    If Right(saveAttAs(1), 1) <> "\" Then saveAttAs(1) = saveAttAs(1) & "\"
                    saveAttAs(1) = saveAttAs(1) & Left(mai.Attachments.item(intAttCount).filename, InStrRev("." & mai.Attachments.item(intAttCount).filename, ".") - 1)
                    saveAttAs(2) = "_ver-" & verNumber
                    saveAttAs(3) = Right(mai.Attachments.item(intAttCount).filename, Len(mai.Attachments.item(intAttCount).filename) - InStrRev(mai.Attachments.item(intAttCount).filename, ".") + 1)
                    DOSFile = Dir(Join(saveAttAs, ""))
                    Do While DOSFile <> ""
                        'That file name found so increment affix
                        verNumber = verNumber + 1
                        saveAttAs(2) = "_ver-" & verNumber
                        DOSFile = Dir(Join(saveAttAs, ""))
                    Loop
                    att.SaveAsFile Join(saveAttAs, "")
'                    Debug.Print Join(saveAttAs, "") & "  ||  " & FSO.GetFile(Join(saveAttAs, "")).Size
'                    att.Delete
'                    mai.Body = mai.Body & vbCrLf & "<file://" & Join(saveAttAs, "") & ">"
'                    mai.Save
                End If
assumeEncrypted:
assumeEmbedded:
            Next
        End If
'        If mai.EntryID = "000000003023B0509815D2119E8D0008C742B26804939900" Then Stop
maiIsNothing:
    Next
    For Each subFolder In fldr.Folders
        attachStrip subFolder, saveFolder
    Next
 
End Sub
Sub testing1(Optional str As String)
 
End Sub
 
Private Sub testing2()
    testing1
End Sub
 
Sub saveAttachments(Optional mai As Object)
Dim att As Attachment
Dim DOSFile As String
Dim saveAttAs(1 To 3) As String
Dim verNumber As Integer
'Dim mai As Object
Dim intAttCount As Integer
Const saveFolder As String = "C:\Documents and Settings\cbottom1\My Documents\MailAttachments"
 
    If Not mai Is Nothing Then
    ElseIf TypeName(Application.ActiveWindow) = "Explorer" Then
        Set mai = Application.ActiveExplorer.Selection.item(1)
    ElseIf TypeName(Application.ActiveWindow) = "Inspector" Then
        Set mai = Application.ActiveInspector.CurrentItem
    Else
        Exit Sub
    End If
    If mai.Class <> olMail Then Exit Sub
    For intAttCount = mai.Attachments.Count To 1 Step -1
        Set att = mai.Attachments(intAttCount)
        If att.Type <> olOLE And att.Type <> olEmbeddeditem Then
            If InStr(att.filename, ".") > 0 Then
                verNumber = 1
                saveAttAs(1) = saveFolder
                If Right(saveAttAs(1), 1) <> "\" Then saveAttAs(1) = saveAttAs(1) & "\"
                saveAttAs(1) = saveAttAs(1) & Left(mai.Attachments.item(intAttCount).filename, InStrRev(mai.Attachments.item(intAttCount).filename, ".") - 1)
                saveAttAs(2) = "_ver-" & verNumber
                saveAttAs(3) = Right(mai.Attachments.item(intAttCount).filename, Len(mai.Attachments.item(intAttCount).filename) - InStrRev(mai.Attachments.item(intAttCount).filename, ".") + 1)
                DOSFile = Dir(Join(saveAttAs, ""))
                Do While DOSFile <> ""
                    'That file name found so increment affix
                    verNumber = verNumber + 1
                    saveAttAs(2) = "_ver-" & verNumber
                    DOSFile = Dir(Join(saveAttAs, ""))
                Loop
                att.SaveAsFile Join(saveAttAs, "")
                att.Delete
                mai.Body = mai.Body & vbCrLf & "<file://" & Join(saveAttAs, "") & ">"
                mai.Save
            End If
        End If
    Next
 
End Sub

Open in new window

0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 700 total points
ID: 26061577
I posted too much!

Try this instead.

Chris
Sub ini_attachStrip()
Dim mai As mailitem
Dim saveAttFolder As String
Dim fldr As Object
Dim myPSTs As Object
    
    saveAttFolder = Environ("userprofile") & "\my documents\mailattachments"
    md saveAttFolder, True
    For Each myPSTs In Application.Session.Folders
        If myPSTs.Name <> "Public Folders" Then
            For Each fldr In myPSTs.Folders
                attachStrip fldr, saveAttFolder
            Next
        End If
    Next
 
End Sub
 
Function md(dosPath As String, Optional createFolders As Boolean)
Dim FSO As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer
    
    md = True
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not FSO.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If
 
        For fldrIndex = 1 To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not FSO.FolderExists(rootdir) Then
                If createFolders Then
                    FSO.CreateFolder rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function
Sub attachStrip(fldr As Object, saveFolder As String)
Dim att As Attachment
Dim DOSFile As String
Dim intAttCount As Integer
Dim lngMailCount As Long
Dim saveAttAs(1 To 3) As String
Dim verNumber As Integer
Dim obj As Object
Dim mai As mailitem
Dim subFolder As Object
Dim FSO As Object
Const sizelimit As Long = 5196
' Secure email Issue see : http://support.microsoft.com/kb/896594
 
    If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject")
    If fldr.DefaultItemType <> olMailItem Then Exit Sub
    For lngMailCount = fldr.items.Count To 1 Step -1
        Set obj = fldr.items(lngMailCount)
        If obj.Class = olMail Then
            Err.Clear
            On Error Resume Next
            Set mai = obj
            On Error GoTo 0
            If Err.Number = 13 Then GoTo assumeEncrypted
            If mai Is Nothing Then GoTo maiIsNothing
            Err.Clear
            For intAttCount = mai.Attachments.Count To 1 Step -1
                Set att = mai.Attachments(intAttCount)
                If att.Type <> olOLE Then
                    verNumber = 1
                    saveAttAs(1) = saveFolder
                    If Right(saveAttAs(1), 1) <> "\" Then saveAttAs(1) = saveAttAs(1) & "\"
                    saveAttAs(1) = saveAttAs(1) & Left(mai.Attachments.item(intAttCount).filename, InStrRev("." & mai.Attachments.item(intAttCount).filename, ".") - 1)
                    saveAttAs(2) = "_ver-" & verNumber
                    saveAttAs(3) = Right(mai.Attachments.item(intAttCount).filename, Len(mai.Attachments.item(intAttCount).filename) - InStrRev(mai.Attachments.item(intAttCount).filename, ".") + 1)
                    DOSFile = Dir(Join(saveAttAs, ""))
                    Do While DOSFile <> ""
                        'That file name found so increment affix
                        verNumber = verNumber + 1
                        saveAttAs(2) = "_ver-" & verNumber
                        DOSFile = Dir(Join(saveAttAs, ""))
                    Loop
                    att.SaveAsFile Join(saveAttAs, "")
                    att.Delete
                    mai.Body = mai.Body & vbCrLf & "<file://" & Join(saveAttAs, "") & ">"
                    mai.Save
                End If
assumeEncrypted:
assumeEmbedded:
            Next
        End If
maiIsNothing:
    Next
    For Each subFolder In fldr.Folders
        attachStrip subFolder, saveFolder
    Next
 
End Sub

Open in new window

0
 
LVL 76

Assisted Solution

by:David Lee
David Lee earned 300 total points
ID: 26061789
The problem can be solved in 2007 by testing the attachment's Type value.  Embedded attachments will have a type of olEmbeddeditem.  that allows the use of logic like that below to avoid embedded items.  
For Each intIndex = Item.Attachments.Count to 1 Step -1
        Set olkAttachment = Item.Attachments.Item(intIndex)
        If olkAttachment.Type <> olEmbeddeditem Then
            olkAttachment.SaveAsFile strFolder & olkAttachment.FileName
            olkAttachment.Delete
        End If
    Next

Open in new window

0
 
LVL 2

Author Closing Comment

by:FlorisMK
ID: 31666667
Chris, I'm flabbergasted that I somehow overlooked the Type property. Just tested this in my implementation and it *is* in fact that simple. Type = olOLE for embedded pictures in RTF messages in 2003, which is all I need for the implementation. Excellent!

BlueDevilFan, points for you as well for concisely pointing out the Type property. Less points though, because your answer is limited to 2007 (though it works in 2003 as well) and you omit the olOLE value.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26078623
Glad we could help

Chris
0
 
LVL 2

Author Comment

by:FlorisMK
ID: 26078992
Celebrated too soon. In an HTML mail, attachments and embedded images both have type olByValue. Still no solution... :-((
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26079071
HAve just looked at an HTML mail with attachments and embedded images.  The attachment count equals actual attachments therefore it may be that a solution can be based off type in association with the mail bodyformat.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26079176
I'm talking rubbish aren't I!

I see the problem don't know of a solution as yet but i'll think on it anyway.

Chris
0
 
LVL 2

Author Comment

by:FlorisMK
ID: 26079541
Not rubbish as such but... well, okay, rubbish :-)

If you come across a solution, I'd love to hear about it!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 26129328
Try this.  Once again it's only for Outlook 2007.
Sub TestAttachmentType(Item As Outlook.MailItem)
    Dim olkAttachment As Outlook.Attachment
    For intIndex = Item.Attachments.count To 1 Step -1
        Set olkAttachment = Item.Attachments.Item(intIndex)
        If IsEmbeddedAttachment(olkAttachment) Then
            olkAttachment.SaveAsFile strFolder & olkAttachment.FILENAME
            olkAttachment.Delete
        End If
    Next
    Set olkAttachment = Nothing
End Sub

Function IsEmbeddedAttachment(olkItem As Outlook.Attachment) As Boolean
    Dim olkProp As Outlook.PropertyAccessor, strTemp As String
    Set olkProp = olkItem.PropertyAccessor
    strTemp = olkProp.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E")
    If InStr(1, strTemp, "@") > 0 Then
        IsEmbeddedAttachment = True
    Else
        IsEmbeddedAttachment = False
    End If
    Set olkProp = Nothing
End Function

Open in new window

0
 
LVL 2

Author Comment

by:FlorisMK
ID: 26130344
That looks promising for 2007. I wonder if this will diffferentiate between embedded images and attachments whose file icon is embedded in the body?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 26131172
Don't know.  Only RTF formatted messages would have a file attachment embedded in the body and I NEVER use RTF.  It is a Microsoft only format that is not usually supported by other mail clients.
0
 
LVL 2

Author Comment

by:FlorisMK
ID: 26137568
That's what I've been trying to tell my client :-D
0

Featured Post

Veeam and MySQL: How to Perform Backup & Recovery

MySQL and the MariaDB variant are among the most used databases in Linux environments, and many critical applications support their data on them. Watch this recorded webinar to find out how Veeam Backup & Replication allows you to get consistent backups of MySQL databases.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below error for MS Exchange server 2010 I. Out Of office not working II. Certificate error "name on the security certificate is invalid or does not match the name of the site" III. Make Internal URLs and External…
Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
Is your OST file inaccessible, Need to transfer OST file from one computer to another? Want to convert OST file to PST? If the answer to any of the above question is yes, then look no further. With the help of Stellar OST to PST Converter, you can e…
Suggested Courses
Course of the Month14 days, 13 hours left to enroll

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question