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