How to Create a macro to run on the folder and subfolders too to detect the doc extension files with comments and throws a log file of it.

Here is a procedure developed by Tushar Mehta to "process" all of the files in folders and subfolders:

Process all files in a folder and, optionally, in sub-folders

A frequent request one runs into is for some way in which one can apply some change to all the files in a folder.  This case presents a modularized solution.  While the implementation may look complex -- it does use a recursive routine to process sub-folders -- the result is a "black box" that should be used without any modification.

An example of how one would use the code is below.  The ListAllFiles subroutine is the main code routine.  It calls the "black box" module named searchForFiles with the appropriate arguments, one of which is a 'callback' routine.  In this example, the callback routine is named processOneFile.

Sub ListAllFiles()

    searchForFiles "C:\tushar\temp\", "processOneFile", "*.*", True

    End Sub

Sub processOneFile(ByVal aFilename As String)

    Debug.Print aFilename

    End Sub

Copy the code below into a standard module in your Visual Basic project.  At the bottom is the example from above.  The solution uses one application specific method, the Run method.  Consequently, it can be used on any platform that supports the Run method.  These applications include -- but may not be limited to -- Excel, Word, and PowerPoint.

Option Explicit

'A modularized solution to process all files in a folder, and optionally all subfolders in the folder _

    Tushar Mehta

'There should be absolutely no reason to modify the searchForFiles subroutine.  Treat it as a blackbox _

 routine.  Do *not* tweak it for each specific search.

'How to use the subroutine: _

 Call it with the four arguments: _

    DirToSearch: The directory you want to search.  Note that it must *not* end in a path separator _

        ( "\" on a Windows OS) _

    ProcToCall: This is the callback procedure called with the full name of each file found _

    FileTypeToFind: This is a search pattern for the files sought.  For example, to find all Excel _

        files use "*.xls".  This argument is optional and defaults to "*.*" (or all files) _

    SearchSubDir: Boolean that specifies whether or not to search nested folders.  The default is False.

'The callback subroutine is where you process each file found.  The signature for the routine should be _

     Sub {subroutine-name}(ByVal aFilename As String)

'Use this callback subroutine to do whatever it is you want to do with each file found.  For an example, _

 see the processOneFile subroutine below.

Sub searchForFiles(ByVal DirToSearch As String, ByVal ProcToCall As String, _

        Optional ByVal FileTypeToFind As String = "*.*", _

        Optional ByVal SearchSubDir As Boolean = False)

    'by Tushar Mehta

    'This subroutine recursively calls itself if SearchSubDir is true and at least one sub-directory exists. _

     There should be no need to make any changes to this routine for any specific search.

    On Error GoTo ErrXIT

    If Right(DirToSearch, 1) = Application.PathSeparator Then _

        DirToSearch = Left(DirToSearch, Len(DirToSearch) - 1)

    If SearchSubDir Then

        Dim aFolder As String, SubFolders() As String

        ReDim SubFolders(0)

        aFolder = Dir(DirToSearch, vbDirectory)

        Do While aFolder <> ""

            If aFolder <> "." And aFolder <> ".." Then

                SubFolders(UBound(SubFolders)) = aFolder

                ReDim Preserve SubFolders(UBound(SubFolders) + 1)

                End If

            aFolder = Dir()

            Loop

        If UBound(SubFolders) <> LBound(SubFolders) Then

            Dim I As Long

            For I = LBound(SubFolders) To UBound(SubFolders) - 1

                searchForFiles _

                    DirToSearch & Application.PathSeparator & SubFolders(I), _

                    ProcToCall, FileTypeToFind, SearchSubDir

                Next I

            End If

        End If

    Dim aFile As String

    aFile = Dir(DirToSearch & Application.PathSeparator & FileTypeToFind)

    Do While aFile <> ""

        aFile = DirToSearch & Application.PathSeparator & aFile

        If (GetAttr(aFile) And vbDirectory) = vbDirectory Then

            searchForFiles aFile, ProcToCall, FileTypeToFind, SearchSubDir

        Else

            Application.Run ProcToCall, aFile

            End If

        aFile = Dir()

        Loop

    Exit Sub

ErrXIT:

    MsgBox "Fatal error: " & Err.Description & " (Code=" & Err.Number & ")"

    Exit Sub

    End Sub

'This is an example of how to use the above subroutine

Sub ListAllFiles()

    searchForFiles "C:\tushar\temp\", "processOneFile", "*.*", True

    End Sub

Sub processOneFile(ByVal aFilename As String)

    Debug.Print aFilename

    End Sub
The actual "processing code" would need to open each document and then use 
[Document].Comments.Count
to determine if the document contains comments and then write the name of the document and whatever details you require to another document which would serve as the log.

Hello Mr Doug ,

I am not that good in macros can you please give me a appropriate solution or can share a doc file included with the above given macro.

I am not able to understand how to include the above code to my doc file.

Thanks & Regards

GAGAN KHURANA

Previously i had a question to just to identify the folder with doc extension files that contain comments or not and macro creates the Two folder named Commented Files and Non-Commented Files.

and you gave the solution that sort them to two folders and creates the log of it.

But now i am having different scenario in which i want macro to go in depth of each folder and creates a log instead of sorting them to two folders named Commented FIles and Non-Commented Files.

Note:Just give me the file names of doc files containing comments for each folder insteacd of making Two Folders named Commented FIles and Non-COmmented FIles.

------------------------------Previous Query Solution:

Sub BatchProcessMoveFiles()
Dim strFilename As String
Dim strPath As String
Const strCommentsPath As String = "Comment Folder\"
Const strNoCommentsPath As String = "Non-commented Folder\"
Dim strFiles As String
Dim oDoc As Document
Dim Log As Document
Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , _
                   "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1) & "\"
        If Not FolderExists(strPath & strCommentsPath) Then MkDir strPath & strCommentsPath
        If Not FolderExists(strPath & strNoCommentsPath) Then MkDir strPath & strNoCommentsPath
    End With
    strFiles = ""
    strFilename = Dir$(strPath & "*.doc")        'should open doc, docx, and docm formats
    While Len(strFilename) <> 0
        WordBasic.DisableAutoMacros 1
        Set oDoc = Documents.Open(strPath & strFilename)
        strFiles = strFiles & Date & "-" & Time & Chr(32) & oDoc.FullName & " moved to "
        'do what you want with the open document
        If oDoc.Content.Comments.Count > 0 Then
            oDoc.Close SaveChanges:=wdDoNotSaveChanges
            Name strPath & strFilename As strPath & strCommentsPath & strFilename
            strFiles = strFiles & strCommentsPath & strFilename & vbCr
        Else
            oDoc.Close SaveChanges:=wdDoNotSaveChanges
            Name strPath & strFilename As strPath & strNoCommentsPath & strFilename
            strFiles = strFiles & strNoCommentsPath & strFilename & vbCr
        End If
        strFilename = Dir$()
        WordBasic.DisableAutoMacros 0
    Wend
    Set oDoc = Nothing
    Set Log = Documents.Add
    Log.Range.Text = strFiles
End Sub

Public Function FolderExists(ByVal PathName As String) As Boolean
Dim lngAttr As Long
    On Error GoTo NoFolder
    lngAttr = GetAttr(PathName)
    If (lngAttr And vbDirectory) = vbDirectory Then
        FolderExists = True
    End If
NoFolder:
End Function

---------------------------------------------------------

Thanks & Regards 

GAGAN KHURANA