Compress pictures in multiple Word documents

Hello,

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!
BstrdoAsked:
Who is Participating?
 
xtermieCommented:
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
http://www.vbaexpress.com/forum/showthread.php?t=16134

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 
        oSh.Select 
        SendKeys "%oi", False 
        SendKeys "%m", False 
        SendKeys "aw{ENTER}{ESC}{ESC}", True 
    Else 
        MsgBox "Image Not found" 
    End If 
     
    Exit Sub 
errhandler: 
    MsgBox "Error: " & Err.Number & " " & Err.Description 
     
End Sub

Open in new window

0
 
raysonleeCommented:
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).
0
 
GrahamSkanRetiredCommented:
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
0
 
raysonleeCommented:
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
            shape.Select()
            wrdDoc.ActiveWindow.Selection.CopyAsPicture()
            Dim dataObject As System.Windows.Forms.IDataObject = Clipboard.GetDataObject()
            If dataObject.GetDataPresent("Bitmap") Then
                Dim bmp As Bitmap = dataObject.GetData("Bitmap")
                bmp.Save(imagefilename)
            End If
        Next

Refer to here for sample of image compression using vb.net:
http://savotdane.blogspot.com/2009/08/how-to-compress-resize-image-in-net-c.html
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.