Compress pictures in multiple Word documents

Posted on 2011-10-03
Last Modified: 2014-02-07

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!
Question by:Bstrdo
    LVL 9

    Expert Comment

    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).
    LVL 76

    Expert Comment

    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
    LVL 16

    Accepted Solution

    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

    LVL 9

    Assisted Solution

    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

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Join & Write a Comment

    The System Center Operations Manager 2012, known as SCOM, is a part of the Microsoft system center product that provides the user with infrastructure monitoring and application performance monitoring. SCOM monitors:   Windows or UNIX/LinuxNetwo…
    This article will show you how to use shortcut menus in the Access run-time environment.
    The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
    Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

    731 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

    Need Help in Real-Time?

    Connect with top rated Experts

    16 Experts available now in Live!

    Get 1:1 Help Now