Dear All,

I am using Office 2013.

I have a folder with many sub folders having word and excel files.

Excel file does not have images but the word documents under each sub folder have many images which I would like to move under each respective folders.

I found this code on the group which used to work but now it is giving run time error '53': File not found and highlights the following:

Kill strPath & "" & strDocumentName & ".htm*"

It used to work and move the images to a folder “MovedToHere”.

Code:
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
I want to fix this code and also amend to run on all the sub folders.
Can someone fix this issue for me please.
Thanks in advance