Option Explicit 
 
Dim scrFso As Object 'a FileSystemObject
Dim scrFolder As Object 'the folder object
Dim scrSubFolders As Object 'the subfolders collection
Dim scrFile As Object 'the file objectr
Dim scrFiles As Object 'the files objectr
 
Sub OpenAllFilesInFolder() 
     
     'starting place for trav macro
     'strStartPath is a path to start the traversal on
     
    Dim strStartPath As String 
    strStartPath = "C:\Afolder" 
     
     'stop the screen flickering
    Application.ScreenUpdating = False 
     
     'open the files in the start folder
    OpenAllFiles strStartPath 
     'search the subfolders for more files
    SearchSubFolders strStartPath 
     
     'turn updating back on
    Application.ScreenUpdating = True 
     
End Sub 
 
 
Sub SearchSubFolders(strStartPath As String) 
     
     'starts at path strStartPath and traverses its subfolders and files
     'if there are files below it calls OpenAllFiles, which opens them one by one
     'once its checked for files, it calls itself to check for subfolders.
     
    If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject") 
    Set scrFolder = scrFso.getfolder(strStartPath) 
    Set scrSubFolders = scrFolder.subfolders 
    For Each scrFolder In scrSubFolders 
        Set scrFiles = scrFolder.Files 
        If scrFiles.Count > 0 Then OpenAllFiles scrFolder.Path 'if there are files below, call openFiles to open them
        SearchSubFolders scrFolder.Path 'call ourselves to see if there are subfolders below
    Next 
     
End Sub 
 
_____________ 
Sub OpenAllFiles(strPath As String) 
     
     ' runs through a folder oPath, opening each file in that folder,
     ' calling a macro called samp, and then closing each file in that folder
     
    Dim strName As String 
    Dim wdDoc As Document 
     
    If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject") 
    Set scrFolder = scrFso.getfolder(strPath) 
    For Each scrFile In scrFolder.Files 
        strName = scrFile.Name 'the name of this file
        Application.StatusBar = strPath & "\" & strName 'the status bar is just to let us know where we are
         'we'll open the file fName if it is a word document or template
        If Right(strName, 4) = ".doc" Or Right(strName, 4) = ".dot" Then 
            Set wdDoc = Documents.Open(FileName:=strPath & "\" & strName, _ 
            ReadOnly:=False, Format:=wdOpenFormatAuto) 
             
             'Call the macro that performs work on the file pasing a reference to it
            DoWork wdDoc 
             
             'we close saving changes
            wdDoc.Close wdSaveChanges 
        End If 
    Next 
     
     'return control of status bar to Word
    Application.StatusBar = False 
End Sub 
 
 'this is where a macro would be that would actually do something
Sub DoWork(wdDoc As Document) 
     
End Sub