Looking for a macro to remove (or to compress) all images in a message

Hi @Lisa Wilke-Thissen 

Thank you for contacting the Microsoft Q&A forum. 

I understand you are looking for a way to remove or reduce images in an email, and I am glad to share a VBA script that can help you achieve this. The macro works by opening the message in edit mode, removing all image elements, and then saving the changes. 

Below are the steps you can follow. 

Step 1:  Press Alt + F11 to open the Microsoft Visual Basic for Applications editor. 

Step 2: You may use ThisOutlookSession or add a new module by right‑clicking Project, selecting Insert, and then choosing Module. 

Step 3: Copy the script below into the module and save it.

Sub RemoveAllGraphicsFromSelection() 
    Dim oSelection As Outlook.Selection 
    Dim oItem      As Object 
    Dim oMail      As Outlook.MailItem 
    Dim oInspector As Outlook.Inspector 
    Dim oDoc       As Object 
    Dim i          As Long 
  
    Set oSelection = Application.ActiveExplorer.Selection 
    If oSelection.Count = 0 Then Exit Sub 
  
    For Each oItem In oSelection 
        If oItem.Class = olMail Then 
            Set oMail = oItem 
            Set oInspector = oMail.GetInspector 
 
            ' 1. Open the message and hide it 
            oInspector.Display 
            oInspector.WindowState = olMinimized 
 
            ' 2. Give Outlook a moment to "Wake up" the editor 
            DoEvents 
            On Error Resume Next 
            oInspector.CommandBars.ExecuteMso "EditMessage" 
            DoEvents 
 
            ' 3. Connect to the Editor 
            Set oDoc = oInspector.WordEditor 
            On Error GoTo 0 
  
            ' 4. Safety Check: Only run if the document object actually exists 
            If Not oDoc Is Nothing Then 
                With oDoc 
                    ' Remove standard images 
                    For i = .InlineShapes.Count To 1 Step -1 
                        .InlineShapes(i).Delete 
                    Next i 
  
                    ' Remove "Red X" placeholders 
                    For i = .Fields.Count To 1 Step -1 
                        If .Fields(i).Type = 3 Then .Fields(i).Delete 
                    Next i 
                End With 
 
                ' 5. Save and Close 
                oMail.Save 
                oMail.Close olSave 
            End If 
        End If 
    Next oItem 
  
    MsgBox "Cleanup Complete!", vbInformation 
End Sub 

Step 4: To allow the macro to run, adjust your Trust Center settings. Go to File > Options > Trust Center. Open Trust Center Settings > Macro Settings > Notification for all macros. 

Step 5: If you would like quick access to the macro, you can add it to the Quick Access Toolbar. Open the small dropdown menu at the top left of Outlook > select More Commands > choose Macros from the list > select your script > Add. 

You can rename it or adjust the display icon if needed. 

Step 6:  Restart Outlook to ensure all changes are fully applied. 

I hope this helps you achieve the result you are looking for. If you have any updates or additional questions, please feel free to share them. 

If the answer is helpful, please click "Accept Answer" and kindly upvote it. If you have extra questions about this answer, please click "Comment".         

Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

Thanks, Vergil,

I will test the macro this evening.

Best regards from Germany,

Lisa