none
Open Word Documents from Root and all Subfolders using Macro RRS feed

  • Question

  • I have a project where I need to open all Word (*.doc?) documents one at a time from a root folder and all of the documents from all (a couple hundred) subfolders.  I already have some code that will do this using the DIR() function, but it only extends to the files in the current (root) folder.  How can I get my macro to extend past and include all Word documents from all subfolders ?  This is what I have so far:

        Dim MyObj As Object, MySource As Object, file As Variant
        Dim strTemp As String
        
        ChangeFileOpenDirectory "R:\Recruiting\Resumes\Raw"
        file = Dir("R:\Recruiting\Resumes\Raw\*.doc?")
        
        While (file <> "")
           
            Documents.Open FileName:=file, ConfirmConversions:=False, _
                ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _
                PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
                WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
            
            Selection.WholeStory
            Selection.Copy
        
            strTemp = Selection.Text
    
            <<<DO STUFF>>>
          
            ActiveDocument.Close
           
            file = Dir
        Wend
    

    Tuesday, November 12, 2013 4:14 PM

All replies

  •            

    Copy the code below into a standard codemodule, set a reference to MS Scripting Runtime, and use code like TestFSO:


    Option Explicit
    Dim objFSO As Scripting.FileSystemObject
    Dim objFolder As Scripting.Folder
    Dim colFiles As Scripting.Files
    Dim objfile As Scripting.file
    Dim Subfolder As Scripting.Folder


    Sub TestFSO()
        Dim myPath As String
        Dim mySString As String
        Dim myArray() As String
        Dim myFiles As Integer
        Dim mySearchSub As Boolean
        Dim i As Integer
        Dim strTemp As String
        Dim docDoc As Document

        myPath = "R:\Recruiting\Resumes\Raw"
        'use the next line to start from the document's current folder
        'myPath = ThisDocument.Path
        mySString = "*.doc?"
        mySearchSub = True

        InitFileNamesArray myPath, mySString, myArray(), myFiles, mySearchSub

        MsgBox myFiles - 1 & " files were found."

        For i = LBound(myArray) To UBound(myArray) - 1
            Set docDoc = Documents.Open(FileName:=myArray(i))
            Selection.WholeStory
            Selection.Copy
            strTemp = Selection.Text
            '<<<DO STUFF>>>
            docDoc.Close
        Next i
    End Sub

    Sub InitFileNamesArray(FilePath As String, _
                           FileSearchString As String, _
                           FileNamesArray() As String, _
                           NumFiles As Integer, _
                           SearchSubfolders As Boolean)
        ReDim FileNamesArray(1 To 1)
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(FilePath)
        Set colFiles = objFolder.Files
        For Each objfile In colFiles
            If objfile.Name Like FileSearchString Then
                FileNamesArray(UBound(FileNamesArray)) = objfile.Path
                ReDim Preserve FileNamesArray(1 To UBound(FileNamesArray) + 1)
            End If
        Next

        If SearchSubfolders Then ShowSubFolders objFolder, FileNamesArray(), FileSearchString

        NumFiles = UBound(FileNamesArray) - 1
    End Sub

    Sub ShowSubFolders(Folder As Scripting.Folder, FileNamesArray() As String, FileSearchString As String)
        For Each Subfolder In Folder.SubFolders
            Set objFolder = objFSO.GetFolder(Subfolder.Path)
            Set colFiles = objFolder.Files
            For Each objfile In colFiles
                If objfile.Name Like FileSearchString Then
                FileNamesArray(UBound(FileNamesArray)) = objfile.Path
                ReDim Preserve FileNamesArray(1 To UBound(FileNamesArray) + 1)
                End If
            Next
            ShowSubFolders Subfolder, FileNamesArray(), FileSearchString
        Next
    End Sub



    Tuesday, November 12, 2013 6:28 PM