Word 2010 VB Macro to save all Images from a doc to a folder

Posted on Thursday, April 12, 2012

This is my attempt to save all the images from a word document to a folder.   I write my blog posts in a word document first , for many different reasons, then I transfer them here.  As part of that I need to convert all my images in my word doc to png image files.   I have been doing it one at a time right clicking and clicking "Save picture as"  but this is tedious, so I came up with this VB script to do it.  Its not perfect, but for my purposes it works great.

First you need to know where the macro tools are located in word 2010.  A lot of this information I got from http://www.addictivetips.com/microsoft-office/create-macros-in-word-2010/
[1] .

Click on View --> Macros -->View Macros

Give the macro a name and then Click on Create.

This will open up the Visual Basic Macro editor.

Here is the program I created

Sub SaveAllImages()
' SaveAllImages Macro
' Author T. Patrick Bailey
    'Full File name, used to reopen the original file
    FileName = ActiveDocument.FullName

    'This is the name I am going to prepend on my image files
    '(mine is based on the original documents name
    prePendFileName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 5)
    prePendFileName = Right(prePendFileName, Len(prePendFileName) - 11)

    'Location where to save the file to
    saveLocaton = "D:\pictures\"
    'Today's date formated
    TodayDateString = Year(Date) & "_"
    If Month(Date) < 10 Then
        TodayDateString = TodayDateString & "0"
    End If
    TodayDateString = TodayDateString & Month(Date) & "_"
    If Day(Date) < 10 Then
        TodayDateString = TodayDateString & "0"
    End If
    TodayDateString = TodayDateString & Day(Date)
    'Folder name
    FolderName = TodayDateString & "_" & prePendFileName

    MsgBox "Saving Images to " & saveLocaton & FolderName & "_files"
    'Delete the folder if it exists
    On Error Resume Next
    Kill saveLocaton & FolderName & "_files\*"  'Delete all files
    RmDir saveLocation & FolderName & "_files"  'Delete folder
    'First Save the current document as is
    'Save file as an html file
    ActiveDocument.SaveAs2 FileName:=saveLocaton & FolderName & ".html", _

    'Delete files that are not images
    Kill saveLocaton & FolderName & ".html"
    Kill saveLocaton & FolderName & "_files\*.xml"
    Kill saveLocaton & FolderName & "_files\*.html"
    Kill saveLocaton & FolderName & "_files\*.thmx"
    'Rename image Files
    'This is written for files with 99 or fewer images
    For x = 1 To 9
        Name saveLocaton & FolderName & "_files\image00" _
        & x & ".png" As saveLocaton & FolderName & "_files\" _
        & prePendFileName & "_00" & x & ".png"
    For x = 10 To 99
        Name saveLocaton & FolderName & "_files\image0" _
        & x & ".png" As saveLocaton & FolderName _
        & "_files\" & prePendFileName & "_0" & x & ".png"
    'Reopen the file as a word document
    Word.Documents.Open (FileName)
    'Set Word to be the active (on top) program
    Word.Application.Visible = True
End Sub

After saving my Macro I wanted to make it available as a button in Microsoft word 2010.  I found a few sites like http://www.addictivetips.com/microsoft-office/word-2010-create-macro-button-and-access-it-from-quick-access-toolbar/ [4] That show how to do this but it only is accurate if you are recording a macro.  I already have a macro so I did the following.

Right click on the Undo button at the top and select “Customize Quick Access Toolbar” 

Select Macros, then select the macro to add, finally click OK.

Now you have a clickable button that will run this vb script

Now that I have said all that I will write out a detailed description of what the code is doing.

Save the full file name, this is used later to reopen the document.

I take the name of the word document and I remove the “.docx” at the end and I remove the first 10 characters from the beginning.  I have a strict way I name my files.  You may want to adjust this to only remove the .docx or .doc .

I have a set folder where I save my image folders to so I just hard code it in here.  Again you may need to change this based on your needs.

I have a need to prepend the date in the format of  “2012_04_12”
 “YYYY_MM_DD”.  This gets the current date and formats it like this.

Sets the folder name and pops a message box.

Just in case you run this program more than once on the same file, this will delete the prior made files and folder.  Also the “On Error Resume Next”  allows the program to skip on an I/O errors just as the file is not there.

Save the current document.  (I forgot to do this once and lost some data so I added this since this program will close the current Document)

Save the file as an html document at the specific location, then close the document.

Delete the .html document and the extra, non-image files that are made in its subfolder.

This renames the image files.  I wanted to change the image file names from image001.png  to 2012_04_12_Document_Name_001.png

I made two simple loops one to hand 1-9 and one to handle 10 to 99.

This re-opens the document as a word format.  Leaving it open as the html version bugged me that is why I closed it deleted the .html version then reopened it.  

Finally this sets word as the active (on top) program.
Well that is it for my code, tweak away and make it your own.

 [1]  Create Macros In Word 2010        
       Visited 04/2012
[2]  VBScript Date function
       Visited 04/2012
[3] VBScript Year function
        Visited 04/2012
[4] Word 2010: Create Macro Button and access it from quick access toolbar
        Visited 04/2012


  1. Thank you for you useful script. How can I modify this VBA script if I would like to save all document pages (with text too) as separate pictures. Regards. Jan

  2. If I was going to do something like that I would just print to PDF then convert the PDF pages to png images. VBScript does not feel like the right way to go.