Microsoft Office Forums - View Single Post - [Solved] Run a macro on multiple docx. files

Peter Carter · 04-09-2013, 08:55 AM

Lets say that I have a macro named ChangeFonts how would I get this macro UpdateDocuments to call for the ChangeFonts macro. Where in the code would I place it. I placed it in the place where it said "Call your other macro or insert its code here" but it does not do anything. So I am asking to see just what the code would look like so that I can see what I am doing wrong.
Thank you

Here is the code that I have, when I run it, it will run with and show no errors, however it also does not process The file. Could anyone look at it and tell me what I have wrong.

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    'Call your other macro or insert its code here
    Selection.Find.ClearFormatting 
    Selection.Find.Replacement.ClearFormatting 
    With Selection.Find 
      .Text = "[" 
      .Replacement.Text = " ~" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = False 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    With Selection.Find 
      .Text = "]" 
      .Replacement.Text = "~" 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = False 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    With Selection.Find 
      .Text = "~*~" 
      .Replacement.Text = " " 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = False 
      .MatchWholeWord = False 
      .MatchWildcards = False 
      .MatchSoundsLike = False 
      .MatchAllWordForms = False 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll 
    Selection.Find.ClearFormatting 
    Selection.Find.Replacement.ClearFormatting 
    With Selection.Find 
      .Text = "~*~" 
      .Replacement.Text = " " 
      .Forward = True 
      .Wrap = wdFindContinue 
      .Format = False 
      .MatchCase = False 
      .MatchWholeWord = False 
      .MatchAllWordForms = False 
      .MatchSoundsLike = False 
      .MatchWildcards = True 
    End With 
    Selection.Find.Execute Replace:=wdReplaceAll
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function