Running a macro with a for loop

[lonesoac0]

Hello all,

I have several thousand Word files that have inconsistent formatting. I have a macro that runs on a single word file at a time. I would like to use VB code to use a for loop to run on all the Word files in the directory. The below is my macro.

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    For i = 1 To .Paragraphs.Count
      With .Paragraphs(i)
        If .Borders(wdBorderBottom).LineStyle <> wdLineStyleNone Then
          .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
          .Range.InsertBefore "______________________" & _
            "________________________________________" & _
            "_________________________________________"
        End If
      End With
    Next
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

[westconn1]

you can use DIR to find all the word files in a folder, likr

mypath = "C:\temp\"  'change to your folder, note trailing \
fn = dir(mypath & "*.docx")    ' change docx if required
do while len(fn) > 0
  set doc = documents.open(mypath & fn)
  with doc.range    ' change this line from activedocument

  ' put the rest of your existing code in here for each document

  doc.close true   ' save changes
  fn = dir   ' get next file
loop

[lonesoac0]

So, I finally got to play with your code. It took me a second to put together what you meant with "change this line from activedocument". I figured, "A guy with THAT much rep cannot really be wrong with such a simple task".

Sub Demo()
mypath = "C:\Users\lonesoac0\Downloads\MedFiles\"  'change to your folder, note trailing \
fn = Dir(mypath & "*.docx")    ' change docx if required
Do While Len(fn) > 0
  Set doc = Documents.Open(mypath & fn)
  Application.ScreenUpdating = False
  Dim i As Long
  With doc.Range    ' change this line from activedocument
With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{2,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    For i = 1 To .Paragraphs.Count
      With .Paragraphs(i)
        If .Borders(wdBorderBottom).LineStyle <> wdLineStyleNone Then
          .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
          .Range.InsertBefore "______________________" & _
            "________________________________________" & _
            "_________________________________________"
        End If
      End With
    Next
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
  doc.Close True   ' save changes
  fn = Dir   ' get next file
Loop
End Sub

[westconn1]

A guy with THAT much rep cannot really be wrong

still easy to make error

probably no need to turn screen updating on and off, just turn off once at start, before loop