Please Note: This article is written for users of the following Microsoft Word versions: 2007 and 2010. If you are using an earlier version (Word 2003 or earlier), this tip may not work for you. For a version of this tip written specifically for earlier versions of Word, click here: Removing Pictures from Multiple Files.
Rosario has a huge number of documents (about 44,000 of them), each of which contains a graphic in the header. She is looking for a way to remove all those graphics without the necessity of opening and modifying each document manually.
Fortunately this can be handled by creating a macro. All you need to do is put all the documents in a folder and then use the macro to search through the folder, open each document, remove the graphic, and save each document. This can be done with a macro like the following:
Sub StripGraphics() Dim oShape As Shape Dim oIShape As InlineShape Dim I As Integer Dim J As Integer With Application.FileSearch .LookIn = "C:\MyStuff\" ' where to search .SearchSubFolders = True ' search the subfolders .FileName = "*.docx" ' file pattern to match ' if more than one match, execute the following code If .Execute() > 0 Then MsgBox "Found " & .FoundFiles.Count & " file(s)." ' for each file you find, run this loop For I = 1 To .FoundFiles.Count ' open the file based on its index position Documents.Open FileName:=.FoundFiles(I) ' document is now active, check all sections For J = 1 To ActiveDocument.Sections.Count With ActiveDocument.Sections(J).Headers(wdHeaderFooterPrimary) ' remove floating graphics from header If .Shapes.Count > 0 Then For Each oShape In .Shapes oShape.Delete Next oShape End If ' remove inline graphics from header If .Range.InlineShapes.Count > 0 Then For Each oIShape In .Range.InlineShapes oIShape.Delete Next oIShape End If End With With ActiveDocument.Sections(J).Headers(wdHeaderFooterFirstPage) ' remove floating graphics from header If .Shapes.Count > 0 Then For Each oShape In .Shapes oShape.Delete Next oShape End If ' remove inline graphics from header If .Range.InlineShapes.Count > 0 Then For Each oIShape In .Range.InlineShapes oIShape.Delete Next oIShape End If End With Next J ' save and close the current document ActiveDocument.Close wdSaveChanges Next I Else MsgBox "No files found." End If End With End Sub
This macro makes the assumption that you want to remove all the graphics (both floating and inline) in the header. These are removed, and each file is resaved. The macro doesn't affect any other graphics in the document.
You should note that this particular macro checks for files that use the DOCX extension. If you have documents that use different extensions (such as DOCM or the older DOC), you'll need to run the macro multiple times. Between each run, change the line that sets the pattern for the file extension. (The line has the comment at the end that says, "file pattern to match".)
Note:
WordTips is your source for cost-effective Microsoft Word training. (Microsoft Word is the most popular word processing software in the world.) This tip (9744) applies to Microsoft Word 2007 and 2010. You can find a version of this tip for the older menu interface of Word here: Removing Pictures from Multiple Files.
Learning Made Easy! Quickly teach yourself how to format, publish, and share your content using Word 2013. With Step by Step, you set the pace, building and practicing the skills you need, just when you need them! Check out Microsoft Word 2013 Step by Step today!
SmartArt provides a way to add classy presentation graphics to your document. Here's a high-level explanation of what you ...
Discover MoreInsert a graphic into a document and Word allows you to add a shadow behind the graphic. You can also adjust the ...
Discover MoreThe resolution at which Word compresses graphics in a document may be bothersome. If it is, your options are very ...
Discover MoreFREE SERVICE: Get tips like this every week in WordTips, a free productivity newsletter. Enter your address and click "Subscribe."
2020-09-28 10:23:04
Gabriel
I found a way to remove images in multiple documents:
Use this code:
__________________________________________
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
Dim rngStory As Word.Range
PathToUse = InputBox("Enter path to the documents:", _
"BatchReplaceAll", _
"C:\ put here the adress with the documents")
If PathToUse = "" Then Exit Sub
If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse & "\"
'Error handler to handle error generated whenever
'the FindReplace dialog is closed
On Error Resume Next
'Close all open documents before beginning
Documents.Close SaveChanges:=wdPromptToSaveChanges
'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document
FirstLoop = True
'Set the directory and type of file to batch process
myFile = Dir$(PathToUse & "*.doc")
While myFile <> ""
'Open document
Set myDoc = Documents.Open(PathToUse & myFile)
If FirstLoop Then
'Display dialog on first loop only
'The Show method includes text in headers and footers.
Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process " & _
"the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
'On subsequent loops (files), a ReplaceAll is
'executed with the original settings and without
'displaying the dialog box again. The Execute method
'does not automatically include headers and footers,
'so they must be searched explicitly.
For Each rngStory In ActiveDocument.StoryRanges
Do
rngStory.Select
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End If
'Close the modified document after saving changes
myDoc.Close SaveChanges:=wdSaveChanges
'Next file in folder
myFile = Dir$()
Wend
End Sub
________________________________________
>>>>>> Don't forget to edit the code with the adress documents <<<<<<
Execute the code, then in the option "Find what:" you write "^g" to find the images; The option "Replace with" dont write nothing.
Now just click in "Replace All"
Done!
Questions: gbr2012@hotmail.com
2020-08-10 01:17:54
Ken
The macro StripGraphics will not work in current versions of Word because as Stephen has said, the statement Application.FileSearch is not available in Word versions 2007 and above. It raises the error 5111.
The macro could be modified using Dir statements and recursive programming and while it will then perform as intended it would be unwise to use on 44,000 files. The macro will have a large run time, of the order of tens of minutes or longer, during which a faulty file could cause the run to abort at an unspecified file. To overcome this, file names should be logged by the macro as they are modified so that the run could be re-started. Furthermore, rather than attempt to modify all files in the one run it would be safer to batch the runs by project, assuming that each project consists of a master project folder and sub folders.
The files will retain the created date but the last modified date will be set to today’s date. This may cause issues when sorting files by date as it will most likely be in a different order to that previously. It is possible in VBA to read a file’s last modified date then re-apply to the re-saved file but this adds another level of complexity to the macro.
2020-08-08 03:01:40
Vu Nguyen
The solution is just what I need; however, I've got an error message: "Run time error 5111: This command is not available on this platform."
I'm using Office 2010 with Windows 10
2016-12-15 11:27:56
Stephen Overall
This Microsoft page reports that Application.FileSearch was removed from Office 2007 on and recommends using FileSystemObject instead:
https://msdn.microsoft.com/en-us/library/office/jj229903.aspx?f=255&MSPPError=-2147217396
"The Application.FileSearch was removed in Office 2007. If accessed, this property will return an error. To work around this issue, use the FileSystemObject to recursively search directories to find specific files."
Got a version of Word that uses the ribbon interface (Word 2007 or later)? This site is for you! If you use an earlier version of Word, visit our WordTips site focusing on the menu interface.
Visit the WordTips channel on YouTube
FREE SERVICE: Get tips like this every week in WordTips, a free productivity newsletter. Enter your address and click "Subscribe."
Copyright © 2024 Sharon Parq Associates, Inc.
Comments