• Status: Solved
  • Priority: High
  • Security: Public
  • Views: 92
  • Last Modified:

Run existing Macro on all word files in folder

Hi ,

I wanted to on how to run a already existing macro on all word files in particular folder "C:\Cleanup1" and export all review comments in to one excel sheet.

Currently I have the below code to export all review comments from word to excel. Can you please give me a code to run this on all MS files (.doc, .Docm, .Doctm) on the folder without opening the files and give the comments on excel sheet like "File name, Comment author, Comment, Date".

COde :
Sub CopyCommentsToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim i As Integer
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    With xlWB.Worksheets(1)
        For i = 1 To ActiveDocument.Comments.Count
            .Cells(i, 1).Formula = ActiveDocument.Comments(i).Initial
            .Cells(i, 2).Formula = ActiveDocument.Comments(i).Range
            .Cells(i, 3).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")
        Next i
    End With
    Set xlWB = Nothing
    Set xlApp = Nothing
End Sub
0
Veena Raju
Asked:
Veena Raju
  • 7
  • 4
  • 2
1 Solution
 
GrahamSkanRetiredCommented:
Try this new version of your macro
Sub CopyCommentsToExcel()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim i As Integer
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim docA As Document
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    strFolder = ActiveDocument.Path
    Set docA = ActiveDocument
    strFile = Dir(strFolder & "\*.doc*")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile)
        
        With xlWB.Worksheets(1)
            For i = 1 To doc.Comments.Count
                .Cells(i, 1).Formula = doc.Comments(i).Initial
                .Cells(i, 2).Formula = doc.Comments(i).Range
                .Cells(i, 3).Formula = Format(doc.Comments(i).Date, "dd/MM/yyyy")
            Next i
        End With
        
        If StrComp(strFile, docA.Name, vbTextCompare) <> 0 Then
            doc.Close wdDoNotSaveChanges
        End If
        strFile = Dir()
    Loop
    docA.Activate
End Sub

Open in new window

0
 
Veena RajuAuthor Commented:
Where should I give the folder path. The path is "C:\Cleanup1"
0
 
Veena RajuAuthor Commented:
Hi Graham,

Thank you so much for the code, however, it it is not working. To give you background.

I have arounf 1000+ word files (.doc, .docm and .doctm) on "C:\Cleanup1" folder. When I run the macro, the all comments on the word files should be listed on one excel sheet.

Could you please help me with it.

Thanks,
veena
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Bill PrewCommented:
Hello Veena,

Give this a try and see if it works for you.

Sub CopyCommentsToExcel()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim i As Integer
    Dim j As Integer
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim docA As Document
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    strFolder = "C:\Cleanup1"
    Set docA = ActiveDocument
    strFile = Dir(strFolder & "\*.doc*")
    j = 0
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile)
        
        With xlWB.Worksheets(1)
            For i = 1 To doc.Comments.Count
                j = j + 1
                .Cells(j, 1).Formula = doc.Comments(i).Initial
                .Cells(j, 2).Formula = doc.Comments(i).Range
                .Cells(j, 3).Formula = Format(doc.Comments(i).Date, "dd/MM/yyyy")
            Next i
        End With
        
        If StrComp(strFile, docA.Name, vbTextCompare) <> 0 Then
            doc.Close wdDoNotSaveChanges
        End If
        strFile = Dir()
    Loop
    docA.Activate
End Sub

Open in new window


»bp
0
 
Veena RajuAuthor Commented:
am getting the Run time error 429 - Activex Component cant define .
0
 
Veena RajuAuthor Commented:
I Tried this pasting on word VBA and it also run perfectly. However, the result just gives me the

Author      Comment      Date, I need to file name also accordingly. Is that possible ?
0
 
GrahamSkanRetiredCommented:
Good morning.
Here is my code adapted to your new requirement

Sub CopyCommentsToExcel2()
    Dim xlApp As Object
    Dim xlWB As Object
    
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim i as Integer
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    strFolder = "C:\Cleanup1"
    strFile = Dir(strFolder & "\*.doc*")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile)
        
        With xlWB.Worksheets(1)
            For i = 1 To doc.Comments.Count
                .Cells(i, 1).Formula = doc.Comments(i).Initial
                .Cells(i, 2).Formula = doc.Comments(i).Range
                .Cells(i, 3).Formula = Format(doc.Comments(i).Date, "dd/MM/yyyy")
            Next i
        End With
        
        doc.Close wdDoNotSaveChanges
        strFile = Dir()
    Loop
End Sub

Open in new window

0
 
GrahamSkanRetiredCommented:
Sorry. By new requirement, I meant searching a named folder,
 This version also saves the document file name
Sub CopyCommentsToExcel3()
    Dim xlApp As Object
    Dim xlWB As Object
    
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim a As Integer
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    strFolder = "C:\Cleanup"
    strFile = Dir(strFolder & "\*.doc*")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile)
        
        With xlWB.Worksheets(1)
            For i = 1 To doc.Comments.Count
                .Cells(i, 1).Formula = doc.Comments(i).Initial
                .Cells(i, 2).Formula = doc.Comments(i).Range
                .Cells(i, 3).Formula = Format(doc.Comments(i).Date, "dd/MM/yyyy")
                .Cells(i, 4).Formula = doc.Name
            Next i
        End With
        
        doc.Close wdDoNotSaveChanges
        strFile = Dir()
    Loop
End Sub

Open in new window

0
 
Veena RajuAuthor Commented:
Am still able to see only the author name, comment and date. FIle name is not given.
find attached resilt file

pls resolve
Book22.xlsx
0
 
Veena RajuAuthor Commented:
Wow It really worked wonder however, am facing below issue in it.

1. Am not sure if all the files are being processed. So, is that possible to list all word files and where ever there is comments, it should pull, If not the comment should be "No comments found" in the excel list/

2. When I run macro, i have few documents for which i have to manually enable to macro (Popups comes). I sthat possible to run it in back end only.
Also, some file has password protected, so I need those files which has error or password in the seperate tab in the same excel sheet. Because, those I can check manually.


i dont know if it a problem, when I was running macro. It suddenly closed VBA and word template by it self. may I know why ? I have folder with 500 word files.
0
 
GrahamSkanRetiredCommented:
Some warning messages  can be suppressed using the .DisplayAlerts property.

You can provide a password if they all use the same or no password.. Files which are not password-protected will ignore the unwanted password, but any documents have a different password will not open.

I have tweaked the code to stop each document's comments overwriting earlier ones.

Sub CopyCommentsToExcel4()
    Dim xlApp As Object
    Dim xlWB As Object
    
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim r As Integer
    Dim i As Integer
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    Application.DisplayAlerts = wdAlertsNone
    strFolder = "C:\Cleanup1"
    strFile = Dir(strFolder & "\*.doc*")
    r = 1
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile, , , , "password")
            
        With xlWB.Worksheets(1)
            .Cells(r, 4).Value = doc.Name
            For i = 1 To doc.Comments.Count
                .Cells(i + r, 1).Value = doc.Comments(i).Initial
                .Cells(i + r, 2).Value = doc.Comments(i).Range
                .Cells(i + r, 3).Value = Format(doc.Comments(i).Date, "dd/MM/yyyy")
                .Cells(i + r, 4).Value = doc.Name
            Next i
        End With
        r = r + doc.Comments.Count + 1
        doc.Close wdDoNotSaveChanges
        strFile = Dir()
    Loop
    Application.DisplayAlerts = wdAlertsAll

End Sub

Open in new window

Remember to change the word "password" to the actual password.
0
 
Veena RajuAuthor Commented:
Wow, its just wow.. I cant still believe that its working. your awsome. But instead of blank space on files where no comments are there. is that possible to give the comment as "No comments noted". ?
0
 
Bill PrewCommented:
But instead of blank space on files where no comments are there. is that possible to give the comment as "No comments noted". ?
See change below, this adds your request.

Sub CopyCommentsToExcel4()
    Dim xlApp As Object
    Dim xlWB As Object
    
    Dim strFolder As String
    Dim strFile As String
    Dim doc As Document
    Dim r As Integer
    Dim i As Integer
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    
    Application.DisplayAlerts = wdAlertsNone
    strFolder = "C:\Cleanup1"
    strFolder = "B:\EE\EE29087096\Files"
    strFile = Dir(strFolder & "\*.doc*")
    r = 1
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile, , , , "password")
            
        With xlWB.Worksheets(1)
            .Cells(r, 4).Value = doc.Name
            If doc.Comments.Count > 0 Then
                For i = 1 To doc.Comments.Count
                    .Cells(i + r, 1).Value = doc.Comments(i).Initial
                    .Cells(i + r, 2).Value = doc.Comments(i).Range
                    .Cells(i + r, 3).Value = Format(doc.Comments(i).Date, "dd/MM/yyyy")
                    .Cells(i + r, 4).Value = doc.Name
                Next i
            Else
                .Cells(r, 2).Value = "No comments noted"
            End If
        End With
        r = r + doc.Comments.Count + 1
        doc.Close wdDoNotSaveChanges
        strFile = Dir()
    Loop
    Application.DisplayAlerts = wdAlertsAll

End Sub

Open in new window


»bp
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 7
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now