Code:
Sub GetPicturesFromWordDocument() ' https://excelfox.com/forum/showthread.php/2760-Get-Pictures-from-Word-Documents-in-All-Sub-Folders?p=15605#post15605 https://excelfox.com/forum/showthread.php/2761-Get-Pictures-from-Word-Documents-in-All-Sub-Folders?p=15613#post15613
Dim strFile As String, strFileType As String, strPath As String, strOriginalFile As String, strDocumentName As String
Dim lngLoop As Long
Let strFileType = "*.png;*.jpeg;*.jpg;*.bmp" 'Split with semi-colon if you want to specify more file types
Let strOriginalFile = ActiveDocument.FullName
Let strDocumentName = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1) ' The macro stores the current active document name ( but without the extension type) in strDocumentName. So if the active document was MyDoc.doc , then strDocumentName will have MyDoc in it.
Let strPath = ActiveDocument.Path ' We also store the path to the current active document in strPath
ActiveDocument.SaveAs strPath & "\" & strDocumentName, wdFormatHTML, , , , , True ' The macro seems to save the active document under its existing name, at the existing place, but with the extension type changed to .htm , so you would have then the active document, if it was MyDoc.doc now saved as MyDoc.htm - …. It is not clear to me why that is being done??
If Dir(strPath & "\MovedToHere", vbDirectory) = "" Then MkDir strPath & "\MovedToHere" ' The macro makes a folder, MovedToHere in the same place as where the current active document is. I have slightly modified this code line, to prevent it erroring if the folder already exists: It only makes the folder if the folder does not exist. - If you try to make a folder when it already exists, then that would chuck up an error
For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";")) ' ======================== The main outer loop is doing the following: It is looping 4 times, going through all your file extension types, .png .jpeg .jpg and .bmp. ( The loop control variable, lngLoop , is going from 0 To 3 ) For each file extension type it is looking for files which are in a folder which, using the same example, would have a name like MyDoc_files . That folder is looked for at the same path as the current active document.So for example, the first loop is looking for files of the extension type .png in that folder
Let strFile = Dir(strPath & "\" & strDocumentName & "_files\" & Split(strFileType, ";")(lngLoop))
Do While strFile <> "" ' The purpose of the Do While __ Loop _ loop is to keep going while you still find files of the extension type currently being looked for.
Name strPath & "\" & strDocumentName & "_files\" & strFile As strPath & "\MovedToHere\" & "New " & strFile ' Each of the files you find gets copied to folder, MovedToHere and has its name modified a bit to have the text "New " added at the start, like for example, Filex.png would become New Filex.png
Let strFile = Dir ' The use of Dir on its own, without any bracket ( ) stuff tells VBA to look again for the next file of the same type and in the same place that it looked the last time
Loop
Next lngLoop ' ============================================================================================
ActiveDocument.Close 0 ' Once we have finished doing all that copying, we close the current active document. It is not clear to me why that is being done. In particular it’s not clear to me why it is done at this point. We could have closed it immediately after we created it, since we have done nothing with it since creating it
Documents.Open strOriginalFile ' We now open the original file we had open at the start of running the macro. Its not clear to me why we do that, other than maybe to get back to having the same file open and active that we had when we started running the macro.
Kill strPath & "\" & strDocumentName & ".htm*"
If Not Dir(strPath & "\" & strDocumentName & "_files\*.*") = "" Then Kill strPath & "\" & strDocumentName & "_files\*.*" ' Kill strPath & "" & strDocumentName & "_files\*.*" could error , if, for example, you had only had files of the type .png .jpeg .jpg or .bmp originally in that folder with the name like MyDoc_files . The reason for that is because the VBA Name statement renames a file, in other words it moves , or in other words it copies the file to somewhere and then deletes the original. So effectively it will be removing all files of the type .png .jpeg .jpg or .bmp from that folder. So I have modified that code line so that it only tries to delete files if there are any files there to delete. I expect the reason the code line is there is so that the next code line works. – This next code line, RmDir strPath & "" & strDocumentName & "_files" , tries to delete the original folder, and that code line would error if any files were in that folder.
RmDir strPath & "\" & strDocumentName & "_files" ' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/rmdir-statement
'strFile = vbNullString ' These last few lines are not needed in VBA. These code lines were considered good practice in programming earlier, I think. Possibly they may have sometimes been needed previously. I am not sure.
'strFileType = vbNullString
'strPath = vbNullString
'lngLoop = Empty
End Sub
Reply With Quote
Originally Posted by Broesel
Bookmarks