Search code examples
vbaoutlookoutlook-2010

MS Outlook 2010 how to reduce picture size in attached messages


i have over 1k emails which all have pictures attached with large size and i want to reduce there size (like 1024x800 document size).

Normally what i do is open message in edit mode then open picture then reduce size finally save message which is very long process.

so i am looking something in vba like Save and remove attachments from email items (VBA)

Sub SaveAttachment() 
'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'Ask for destination folder
myOrt = InputBox("Destination", "Save Attachments", "C:\")

On Error Resume Next

'work on selected items
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'for all items do...
For Each myItem In myOlSel

    'point on attachments
    Set myAttachments = myItem.Attachments

    'if there are some...
    If myAttachments.Count > 0 Then

        'add remark to message text
        myItem.Body = myItem.Body & vbCrLf & _
            "Removed Attachments:" & vbCrLf

        'for all attachments do...
        For i = 1 To myAttachments.Count

            'save them to destination
            myAttachments(i).SaveAsFile myOrt & _
                myAttachments(i).DisplayName

            'add name and destination to message text
            myItem.Body = myItem.Body & _
                "File: " & myOrt & _
                myAttachments(i).DisplayName & vbCrLf

        Next i

        'for all attachments do...
        While myAttachments.Count > 0

            'remove it (use this method in Outlook XP)
            'myAttachments.Remove 1

            'remove it (use this method in Outlook 2000)
            myAttachments(1).Delete

        Wend

        'save item without attachments
        myItem.Save
    End If

Next

'free variables
Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub

note: i have to keep large picture for at least a month after that i want to reduce that picture sizes so i can not set any option where i am receiving smaller size email.


Solution

  • The Outlook object model doesn't provide anything for editing attachments on the fly. However, as a workaround you may use a low-level property for getting an setting a byte array which represents the attached file. The PropertyAccessor class from the Outlook object model (see the corresponding property of the Attachment class) can be used for retrieving the PR_ATTACH_DATA_BIN property value. The DASL name is "http://schemas.microsoft.com/mapi/proptag/0x37010102".

    The Outlook object model allows to save the attached file on the disk using the SaveAsFile method of the Attachment class, do the required changes and re-attach it anew using the Add method of the Attachments class.