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

Macro on folder

Hi Team,

I would Like to create a VBA code for both Excel and MS word to export all comments and update on on master excel file. This might be confusing. For example - Lets say I have 50 excel files and 50 word files on folder called "C:\Cleanup1" which has all review comments from the senior. So, I need to run a macro on "Cleanup1" folder which should through me review comments on file wise in one master excel file.

The format should be

File name - File type (word/excel)-Comment author-Comment scope -Comment -Date

Currently am using below code on word, where in I have to run this on every file one by one., which is painfull as I have 2000+ both excel and word files on above mentioned path. Could you please customise a VBA for me on priority basis, as I have to deliver this today.

Thanks,

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 = "C:\Cleanup1"
    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


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 = "C:\Cleanup1"
    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 Raju
Asked:
Veena Raju
  • 9
  • 8
1 Solution
 
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:
Hi Bill,
THis really works brilliant !!> Thanks a lot..

However, i have noticed few things which I would like to include in the above Macro.

1. The result gives only the author name, comment and date. When I run the macro on huge data, it is necessary to know on which file, I have which comments right. Can it be done in the above VBA macro script. basically i need below columns.

FIle name - FIle type (Excel or word) - Author (name) - Comment - Date.

2. I noticed that when I run above code, on some files it ask me for "Enable macro" popup and also on password protected file, the VBA stops and the template gets closed. Is that possible to run all this pop ups in the back end. Like hit yet to all macro enable popups, and ignore file the file is password protected or has error and continue with the rest ?

3. Last but not the least, I wanted this to be shared with my team as template. Please give some input or tipes on that//



Looking forward for your suggestion. As said earlier  it is quite urgent so pls excuse me
0
 
Bill PrewCommented:
Okay, I've done a little more work on this (really about all I can on a single question), and have a VBScript approach for you.  Same idea as the approach you have, but runs from a command line so easier to use.

Save this script to a VBS file (I named it EE29087096.vbs here), open a DOS command prompt window, change to the folder you placed the VBS in, and then run the following command:

cscript "EE29087096.vbs" "C:\Cleanup1"

CSCRIPT is the windows command to run the VBS scrip, and then you tell it the location of the VBS file to run.  The final parm is used by the VBS script and is the path of the folder to process files in.

A few notes:
  • This will process both Excel and Word files trying to extract comments.
  • It creates a new workbook name "Comments.xlsx" in the folder where the VBS exists, with the results of the extract.
  • It tries to suppress extra popups, and that works pretty well for Excel files.  For Word files that are password protected there doesn't seem to be a way to disable the prompt for the password, but just enter the password there, or cancel.  Things should keep going and an error will be logged in the report for that file.
  • After it finishes open the COmments.xlsx file produced and see how it looks.
  • Excel comments don't store the date they were created so I left that blank.
  • I included a sample from a small test here below the code.

Option Explicit

' Constants
Const xlOpenXMLWorkbook = 51
Const strPassword = ""

' Global variables
Dim objFso, objShell, objWord, objExcel
Dim strFolder, objFolder, objFile, objCommentWorkbook, objCommentSheet
Dim intRow

' Create general use objects
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

' Get folder name to process off the command line, make sure it's valid
If (WScript.Arguments.Count > 0) Then
    strFolder = objFSO.GetAbsolutePathname(Wscript.Arguments(0))
    If Not objFSO.FolderExists(strFolder) Then
        WScript.StdErr.WriteLine "Specified folder does not exist."
        WScript.Quit
    End If
Else
    WScript.StdErr.WriteLine "No folder name specified to process."
    WScript.Quit
End If

' Load Word, but don't show it
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
objWord.DisplayAlerts = 0

' Load Excel, but don't show it
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False

' Create Excel workbook for comments listing, add header row
Set objCommentWorkbook = objExcel.Workbooks.Add
Set objCommentSheet = objCommentWorkbook.Sheets(1)
intRow = 0
AddComment "File", "Person", "Date", "Comment", "Error"

' Access the folder to process
Set objFolder = objFSO.GetFolder(strFolder)

' Process all files in folder
For Each objFile In objFolder.Files

    ' Only process Word and Excel files
    Select Case Left(LCase(objFSO.GetExtensionName(objFile.Path)),3)
        Case "xls"
            Wscript.Echo "Processing file = """ & objFile.Name & """"
            DoExcel objFile.Path, objFile.Name
        Case "doc"
            Wscript.Echo "Processing file = """ & objFile.Name & """"
            DoWord objFile.Path, objFile.Name
    End Select

Next

' Save Excel report of all comments found
objCommentWorkbook.SaveAs objFSO.GetParentFolderName(WScript.ScriptFullName) & "\Comments.xlsx", xlOpenXMLWorkbook

' End Word and Excel, done
objWord.Quit
objExcel.Quit


Sub DoExcel(strPath, strName)
    ' Local variables
    Dim objWorkbook, intCount, i, objSheet, objComment

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objWorkbook = objExcel.Workbooks.Open(strPath, 0, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening workbook."
        On Error GoTo 0
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For Each objSheet In objWorkbook.Worksheets
        For Each objComment In objSheet.Comments
            AddComment strName, objComment.Author, "", objComment.Text, ""
            intCount = intCount + 1
        Next
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objWorkbook.Close (False)
End Sub

Sub DoWord(strPath, strName)
    ' Local variables
    Dim objDoc, intCount, i

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objDoc = objWord.Documents.Open(strPath, False, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening document."
        On Error GoTo 0
        objWord.Visible = False
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For i = 1 To objDoc.Comments.Count
        With objDoc.Comments(i)
            AddComment strName, .Initial, FormatDateTime(.Date, 2), .Range, ""
            intCount = intCount + 1
        End With
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objDoc.Close (False)
End Sub

Sub AddComment(strName, strInitial, strDate, strComment, strError)
    ' Move to next row of report and add an entry
    intRow = intRow + 1
    objCommentSheet.Cells(intRow, 1).Value = strName
    objCommentSheet.Cells(intRow, 2).Value = strInitial
    objCommentSheet.Cells(intRow, 3).Value = strDate
    objCommentSheet.Cells(intRow, 4).Value = strComment
    objCommentSheet.Cells(intRow, 5).Value = strError
End Sub

Open in new window

sshot-445.png

»bp
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

 
Veena RajuAuthor Commented:
When I tried running the macro, it shows below pop up2018-03-05_2-52-26.png
0
 
Veena RajuAuthor Commented:
Extreamlyu sorry ma not used to DOC command. IS that not possible to run this on VBA and create as Macro template. Because, I might have to share this with people.
0
 
Bill PrewCommented:
Did you try it the way I instructed, and did it work that way?

I think it may actually be easier to share this way than by sharing in Excel, although either could be made to work.

If you can't use this that's fine, you should be able to adapt the code easily to VBA in an Excel macro.


»bp
0
 
Veena RajuAuthor Commented:
Could you please be bit specific about running the above COde on Excel VBA screen. I am again getting the save error as attached image.  when I tried copy pasting the VBA code to Excel VBA screens and hit the F5 to run the code. Its giving me a popup as above
0
 
Bill PrewCommented:
My second post is not VBA code, it is VBS code.


»bp
0
 
Veena RajuAuthor Commented:
I got it, Can I get the VBA code for same. I am not used to VBS codes.
0
 
Veena RajuAuthor Commented:
ANY UPDATE ON THIS ?
0
 
Bill PrewCommented:
NO.
0
 
Veena RajuAuthor Commented:
Hi Bill,

Do you mean, that this feature cant be done on the VBA code ?
0
 
Bill PrewCommented:
Here is a VBA version.

Option Explicit

' Global constants
Const strPassword = "password"
Const strFolder = "C:\Cleanup1"

' Global variables
Dim objWord As Object
Dim objExcel As Object
Dim objCommentSheet As Object
Dim intRow As Long

Sub CopyCommentsToExcel()

    ' Constants
    Const xlOpenXMLWorkbook = 51
    Const xlTop = -4160
    
    ' Local variables
    Dim objFso As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objCommentWorkbook As Object
   
    ' Create general use objects
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objWord = Application

    objWord.DisplayAlerts = 0

    ' Load Excel, show it
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True

    ' Create Excel workbook for comments listing, add header row
    Set objCommentWorkbook = objExcel.Workbooks.Add
    Set objCommentSheet = objCommentWorkbook.Sheets(1)
    intRow = 0
    AddComment "File", "Person", "Date", "Comment", "Error"

    ' Access the folder to process
    Set objFolder = objFso.GetFolder(strFolder)

    ' Process all files in folder
    For Each objFile In objFolder.Files

        ' Only process Word and Excel files
        Select Case Left(LCase(objFso.GetExtensionName(objFile.Path)), 3)
            Case "xls"
                DoExcel objFile.Path, objFile.Name
            Case "doc"
                DoWord objFile.Path, objFile.Name
        End Select

    Next

    ' Resize columns
    With objCommentSheet.Cells
        .VerticalAlignment = xlTop
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With

    ' Enable alerts
    objExcel.DisplayAlerts = True
    objWord.DisplayAlerts = -1

End Sub

Sub DoExcel(strPath As String, strName As String)
    ' Local variables
    Dim objWorkbook As Object
    Dim intCount As Long
    Dim i As Long
    Dim objSheet As Object
    Dim objComment As Object

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objWorkbook = objExcel.Workbooks.Open(strPath, 0, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening workbook."
        On Error GoTo 0
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For Each objSheet In objWorkbook.Worksheets
        For Each objComment In objSheet.Comments
            AddComment strName, objComment.Author, "", objComment.Text, ""
            intCount = intCount + 1
        Next
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objWorkbook.Close (False)
End Sub

Sub DoWord(strPath As String, strName As String)
    ' Local variables
    Dim objDoc As Object
    Dim intCount As Long
    Dim i As Long

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objDoc = objWord.Documents.Open(strPath, False, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening document."
        On Error GoTo 0
        objWord.Visible = False
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For i = 1 To objDoc.Comments.Count
        With objDoc.Comments(i)
            AddComment strName, .Initial, FormatDateTime(.Date, 2), .Range, ""
            intCount = intCount + 1
        End With
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objDoc.Close (False)
End Sub

Sub AddComment(strName As String, strInitial As String, strDate As String, strComment As String, strError As String)
    ' Move to next row of report and add an entry
    intRow = intRow + 1
    objCommentSheet.Cells(intRow, 1).Value = strName
    objCommentSheet.Cells(intRow, 2).Value = strInitial
    objCommentSheet.Cells(intRow, 3).Value = strDate
    objCommentSheet.Cells(intRow, 4).Value = strComment
    objCommentSheet.Cells(intRow, 5).Value = strError
End Sub

Open in new window


»bp
0
 
Veena RajuAuthor Commented:
Hi Bill thank a lot. I dont how enough I can thank you. However, the script is not running for Word files. For all word file am getting error message. but I cpould open them manually.

File      Person      Date      Comment      Error
00000 P1-01-US U2017.docx                        Error "438 - Object doesn't support this property or method" opening document.
00000 P1-08-US Appand disclosures-2.docx                        Error "438 - Object doesn't support this property or method" opening document.
00000 P1_03_US_Understand significant data, assumptions and the valuation process 2017.docx                        Error "438 - Object doesn't support this property or method" opening document.
048683.doc                        Error "438 - Object doesn't support this property or method" opening document.
048692.doc                        Error "438 - Object doesn't support this property or method" opening document.
107GL Service org eval - BNYM.docm                        Error "438 - Object doesn't support this property or method" opening document.
107GL Service org eval - WTW.docm                        Error "438 - Object doesn't support this property or method" opening document.
16 .10.03 (E)-1.docx                        Error "438 - Object doesn't support this property or method" opening document.
16 .10.04 (E).docx-1.docx                        Error "438 - Object doesn't support this property or method" opening document.
16 10.05 (HWGT260D)-1.docx                        Error "438 - Object doesn't support this property or method" opening document.
0
 
Bill PrewCommented:
I tested that exact code here and it worked okay.

You are running this from within Word, correct?

And what changes did you make to the code I posted?  It might be best if you copy out the exact code you are running that is giving the error and paste it up here, just in case something happened when you copied it into Word there.

Also, can you share one of the Word files that is producing this error as an attachment here, so that I can test with it here please.


»bp
0
 
Veena RajuAuthor Commented:
Hi Bill, Its working extreamly fine now in the word. Initially i pasted it in the excel. I wanted this to be add in the command panel. So i used this script. but its not working. Could you please help me

Sub Copy_comments_to_excel(control As IRibbonControl)
        Copy_comments_to_excel
End Sub

Option Explicit

' Global constants
Const strPassword = "password"
Const strFolder = "C:\Cleanup1"

' Global variables
Dim objWord As Object
Dim objExcel As Object
Dim objCommentSheet As Object
Dim intRow As Long

Sub CopyCommentsToExcel()

    ' Constants
    Const xlOpenXMLWorkbook = 51
    Const xlTop = -4160
    
    ' Local variables
    Dim objFso As Object
    Dim objShell As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim objCommentWorkbook As Object
   
    ' Create general use objects
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    Set objWord = Application

    objWord.DisplayAlerts = 0

    ' Load Excel, show it
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = True

    ' Create Excel workbook for comments listing, add header row
    Set objCommentWorkbook = objExcel.Workbooks.Add
    Set objCommentSheet = objCommentWorkbook.Sheets(1)
    intRow = 0
    AddComment "File", "Person", "Date", "Comment", "Error"

    ' Access the folder to process
    Set objFolder = objFso.GetFolder(strFolder)

    ' Process all files in folder
    For Each objFile In objFolder.Files

        ' Only process Word and Excel files
        Select Case Left(LCase(objFso.GetExtensionName(objFile.Path)), 3)
            Case "xls"
                DoExcel objFile.Path, objFile.Name
            Case "doc"
                DoWord objFile.Path, objFile.Name
        End Select

    Next

    ' Resize columns
    With objCommentSheet.Cells
        .VerticalAlignment = xlTop
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With

    ' Enable alerts
    objExcel.DisplayAlerts = True
    objWord.DisplayAlerts = -1

End Sub

Sub DoExcel(strPath As String, strName As String)
    ' Local variables
    Dim objWorkbook As Object
    Dim intCount As Long
    Dim i As Long
    Dim objSheet As Object
    Dim objComment As Object

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objWorkbook = objExcel.Workbooks.Open(strPath, 0, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening workbook."
        On Error GoTo 0
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For Each objSheet In objWorkbook.Worksheets
        For Each objComment In objSheet.Comments
            AddComment strName, objComment.Author, "", objComment.Text, ""
            intCount = intCount + 1
        Next
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objWorkbook.Close (False)
End Sub

Sub DoWord(strPath As String, strName As String)
    ' Local variables
    Dim objDoc As Object
    Dim intCount As Long
    Dim i As Long

    ' Try to open the file, report and exit if errors
    On Error Resume Next
    Set objDoc = objWord.Documents.Open(strPath, False, True, , strPassword)
    If Err.Number > 0 Then
        AddComment strName, "", "", "", "Error """ & Err.Number & " - " & Err.Description & """ opening document."
        On Error GoTo 0
        objWord.Visible = False
        Exit Sub
    End If

    On Error GoTo 0

    ' Extract any comments and report them
    intCount = 0
    For i = 1 To objDoc.Comments.Count
        With objDoc.Comments(i)
            AddComment strName, .Initial, FormatDateTime(.Date, 2), .Range, ""
            intCount = intCount + 1
        End With
    Next

    ' If no comments found report that
    If intCount = 0 Then
        AddComment strName, "", "", "", "No comments found."
    End If

    ' Close file
    objDoc.Close (False)
End Sub

Sub AddComment(strName As String, strInitial As String, strDate As String, strComment As String, strError As String)
    ' Move to next row of report and add an entry
    intRow = intRow + 1
    objCommentSheet.Cells(intRow, 1).Value = strName
    objCommentSheet.Cells(intRow, 2).Value = strInitial
    objCommentSheet.Cells(intRow, 3).Value = strDate
    objCommentSheet.Cells(intRow, 4).Value = strComment
    objCommentSheet.Cells(intRow, 5).Value = strError
End Sub

Open in new window

0
 
Bill PrewCommented:
I can't debug your code for you, you will need to do that.  I have provided a working and tested (by you and me) solution to the question you asked, which wanted VBA procedure run from Word.

Please don't keep changing the question, if you have a new question, close this one appropriately, and please post a new different question.


»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

Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

  • 9
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now