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