Get Images From Word Document And Rename And Save To A Folder

[mesp9942]

Hi,
I have a word document with images in it and using microsoft word VBA I want to go through the document, name each image, and move these images to a folder. I have tried inlineobjects, but this does not include each image on my page. The only way I have been able to extract them is by saving the doc as a webpage, but I am not able to delete or rename the images this way.
Please help.

[Excel Fox]

Try this

Sub GetPicturesFromWordDocument()

    Dim strFile As String
    Dim strFileType As String
    Dim strPath As String
    Dim lngLoop As Long
    Dim strOriginalFile As String
    Dim strDocumentName As String
    strOriginalFile = ActiveDocument.FullName
    strDocumentName = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)
    strPath = ActiveDocument.Path
    ActiveDocument.SaveAs strPath & "\" & strDocumentName, wdFormatHTML, , , , , True
    strFileType = "*.png;*.jpeg;*.jpg;*.bmp" 'Split with semi-colon if you want to specify more file types.
     
    MkDir strPath & "\MovedToHere"
    For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
        strFile = Dir(strPath & "\" & strDocumentName & "_files\" & Split(strFileType, ";")(lngLoop))
        Do While strFile <> ""
            Name strPath & "\" & strDocumentName & "_files\" & strFile As strPath & "\MovedToHere\" & "New " & strFile
            strFile = Dir
        Loop
    Next lngLoop
    ActiveDocument.Close 0
    Documents.Open strOriginalFile
    Kill strPath & "\" & strDocumentName & ".htm*"
    Kill strPath & "\" & strDocumentName & "_files\*.*"
    RmDir strPath & "\" & strDocumentName & "_files"
    strFile = vbNullString
    strFileType = vbNullString
    strPath = vbNullString
    lngLoop = Empty
     
End Sub