Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Run Macro in all open files 1

Status
Not open for further replies.
richiwatts

richiwatts

Technical User
Jun 21, 2002
180
GB
How do I get the following recorded Macro to run on all open files? Also for the last find replace I wanted to make the text bold but the macro deletes it.

Code: 
Sub Replace_inallfiles()


    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = _
            "\<\!-- TRANSLATION [0-9] STARTS --\>*\<\!-- TRANSLATION [0-9] ENDS --\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = False
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winExternal")
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winExternal")
    With Selection.Find
        .Text = "<!-- TRANSLATION ^# STARTS -->"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winExternal")
    With Selection.Find
        .Text = "<!-- TRANSLATION ^# STARTS -->"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winExternal")
    With Selection.Find
        .Text = "<!-- TRANSLATION ^# ENDS -->"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winExternal")
    With Selection.Find
        .Text = "\<*\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("tw4winInternal")
    With Selection.Find
        .Text = "<b>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "</b>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "\<b\>*\<\/b\>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
End Sub
 
Sort by date Sort by votes
If it si easier to run this macro on a batch of files in a folder and sub-folder that would also help
 
Upvote 0 Downvote
1. Unless you need the properties, get rid of some crap. Recording a macro often adds a huge amount of extraneous stuff.
Code: 
    With Selection.Find
        .Text = "<b>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

Can be shortened to:
Code: 
    With Selection.Find
        .Text = "<b>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
    End With

I am sure there are other code shortening point here as well. I have not looked deeply.

2. To go through ANY set of instructions for all open documents:
Code: 
Sub DoAllOpen()
Dim aDoc As Document
For Each aDoc In Documents
  aDoc.Activate
  Call Replace_infile
Next aDoc
End Sub
This calls your procedure for every open document. Notice I renamed your procedure, as your procedure does not, in fact, replace in all files.

You could put the all documents instruction into your procedure. However, it is good practice to keep procedures "chunked" up. So having the instructions for EACH file as Replace_infile is good. Then a separate procedure that calls the instructions for each docoument.

3. You can process action on all files in a folder. Either use the Dir function, or FileSystemObject. For an example of Dir:
Code: 
Sub AllFoldersFiles()
Dim myFile
Dim myPath As String
myPath = "c:\test\test2\"
myFile = Dir(myPath & "*.doc")
Do While myFile <> ""
    Documents.Open FileName:=myPath & myFile
    Call Replace_infile
    ActiveDocument.Close wdSaveChanges
    myFile = Dir
Loop
This would execute the procedure Replace_infile on every .doc file in the folder c:\test\test2.

To propagate through folders and sub-folders it is better to use FileSystemObject.

4. The last find replace has no bold instruction.


Gerry
My paintings and sculpture
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Andrzejek
  • Question
Open Word as ReadOnly 1
Replies
6
Views
393
Chriss Miller
C
remeng
  • Locked
  • Question
If obsolete - deactivate all but one macro
Replies
6
Views
457
mintjulep
M
remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
777
strongm
strongm
remeng
  • Locked
  • Helpful tip
Microsoft Office 365 Word Macro Causing a Project is unviewable error
Replies
1
Views
1K
dhookom
dhookom
remeng
  • Locked
  • Question
run PowerPoint macro on open
Replies
0
Views
195
remeng
remeng

Part and Inventory Search

Sponsor

Back
Top