Compress pictures in multiple Word documents


I need to compress pictures in a great number of Word documents. Is there any way of doing this on multiple documents at once in Word 2007, or do I have to open every single document and do it manually?

Thank you in advance!
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

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.

If you have a large number of documents that is enough to justify the effort, you can write an application to do it. Search for images in the doc, compress and save it. Otherwise you may have to do it manually one by one (perhaps with the help of macro).
Unfortunately the Compress functionality isn't implemented in the Word Object model, so programmatic manipulation would be very difficult. You may have to look for a third party application
You could compress all images one by one though.
There is some code written here that works on Powerpoint...could take the same approach for Word

Could try to do it...
Sub AACompressImages() 
    Dim oSh As Shape 
    Dim lCurrSlide As Long 
    Dim SlideName 
    Dim intCurrSlide 
    Dim oSlide As Slide 
    On Error Goto errhandler 
    Set oSlide = ActivePresentation.Slides("chartmanage") 
    lCurrSlide = oSlide.SlideIndex 
    ActiveWindow.View.GotoSlide lCurrSlide 
    Set oSh = Module3.GetShapeTaggedWith("picture", "fake", oSlide) 
    If Not oSh Is Nothing Then ' we found it
        ActivePresentation.Application.DisplayAlerts = ppAlertsNone 
        SendKeys "%oi", False 
        SendKeys "%m", False 
        SendKeys "aw{ENTER}{ESC}{ESC}", True 
        MsgBox "Image Not found" 
    End If 
    Exit Sub 
    MsgBox "Error: " & Err.Number & " " & Err.Description 
End Sub

Open in new window

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
Here is a sample to locate images (inlineshapes) in Word and extract them, you have to repeat the same for shapes:

   wrdApp = CreateObject("Word.Application")
        wrdDoc = wrdApp.Documents.Open(sourceFile, , True, , , , , , , Word.WdOpenFormat.wdOpenFormatAuto)
        For Each shape As Word.InlineShape In wrdDoc.InlineShapes
            Dim dataObject As System.Windows.Forms.IDataObject = Clipboard.GetDataObject()
            If dataObject.GetDataPresent("Bitmap") Then
                Dim bmp As Bitmap = dataObject.GetData("Bitmap")
            End If

Refer to here for sample of image compression using
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 Word

From novice to tech pro — start learning today.