Simple Looping Example needed

**msmithdynamicsgp** · 06-11-2011, 11:50 PM

I'd like to loop through all .docm files in a directory (call it C:\Work for example), open the document, and perform some action on each file in the directory.

What code can accomplish this? I know it is simple as can be in excel but I have had trouble finding analogous word examples.

The action I want to perform is irrelevant but I included it in code tags below.

Sub Update()

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "June"
        .Replacement.Text = "July"
        .Forward = True
        .Wrap = wdFindContinue

    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "May"
        .Replacement.Text = "June"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "April"
        .Replacement.Text = "May"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Thanks in advance,

-Michael

**MarvinP** · 06-12-2011, 01:23 AM

Hi,
Office VBA in Word is very close to Excel.

See if http://www.ozgrid.com/VBA/loop-through.htm can't be modified to do what you need.

**royUK** · 06-12-2011, 03:28 AM

You won't be able to use FileSearch, it no longer works with Office 2007 on.

This will be adaptable for your needs. It's written for Excel, but should work in Word

'---------------------------------------------------------------------------------------
' Author    : Roy Cox (royUK)
' Website   : for more examples and Excel Consulting
' Date      : 08/06/2011
' Purpose   : Copy specific cells from all workbooks ina directory
'---------------------------------------------------------------------------------------

Option Explicit


Sub CombineData()
    Dim oWbk As Workbook
    Dim uRng As Range
    Dim rNextRw As Long
    Dim sFil As String
    Dim sPath As String

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        '   On Error GoTo exithandler 'add this back after testing
        'enter full path here
        'this assumes a Data folder in this workbook's folder
        sPath = ThisWorkbook.Path & Application.PathSeparator & "Data"
        ChDir sPath
        sFil = Dir("*.xls")    'change or add formats
        Do While sFil <> ""    'will start LOOP until all files in folder sPath have been looped through
            With ThisWorkbook.Worksheets(1)
                Set oWbk = Workbooks.Open(sPath & Application.PathSeparator & sFil)    'opens the file
                rNextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                ActiveSheet.Range("b11").Copy .Cells(rNextRw, 1)    'company
                ActiveSheet.Range("b12").Copy .Cells(rNextRw, 2)    'contact
                'etc
            End With
            oWbk.Close False     'close source workbook
            sFil = Dir
        Loop
exithandler:
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub