Extracting Comments from all WORD documents in a Folder and merging into 1 Excel file

Hi Guys, I have browsed through and created a code that extracts comments from all WORD documents in a folder and merges into 1 Excel file at last.. its a 2 step process : 1st : To extract Comments from all WORD doc in a folder i have pasted the below script in Macro of WORD application:

Sub exportcomments()
' Exports comments from a MS Word document to Excel and associates them with the heading paragraphs
' they are included in. Useful for outline numbered section, i.e. 3.2.1.5....
' Need to set a VBA reference to "Microsoft Excel 14.0 Object Library"

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim i As Integer, HeadingRow As Integer
Dim objPara As Paragraph
Dim objComment As Comment
Dim strSection As String
Dim actdoc As String
Dim strTemp
Dim myRange As Range

    Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
'xlApp.Visible = False
Set xlWB = xlApp.Workbooks.Add 'create a new workbook
With xlWB.Worksheets(1)
' Create Heading 

    strSection = "preamble" 'all sections before "1." will be labeled as "preamble"
    strTemp = "preamble"
    If ActiveDocument.Comments.Count = 0 Then
        MsgBox ("No comments")
        Exit Sub
    End If

    For i = 1 To ActiveDocument.Comments.Count
        'Getting Name of the current Word
        actdoc = CreateObject("scripting.filesystemobject").getbasename(ActiveDocument.Name)
        Set myRange = ActiveDocument.Comments(i).Scope
        strSection = ParentLevel(myRange.Paragraphs(1)) ' find the section heading for this comment
        'MsgBox strSection
        '.Cells(i + HeadingRow, 1).Formula = ActiveDocument.Comments(i).Index
        .Cells(i + HeadingRow, 1).Formula = ActiveDocument.Name
        .Cells(i + HeadingRow, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
        .Cells(i + HeadingRow, 3).Value = ActiveDocument.Comments(i).Scope.FormattedText
        .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Range
        .Cells(i + HeadingRow, 5).Formula = ActiveDocument.Comments(i).Initial
        .Cells(i + HeadingRow, 6).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")
        .Cells(i + HeadingRow, 7).Formula = ActiveDocument.Comments(i).Range.ListFormat.ListString

    Next i
    'Saving the Excel in temp folder
xlWB.ActiveSheet.SaveAs FileName:=ActiveDocument.Path & "temp" & actdoc & ".xlsx", ReadOnlyRecommended:=False, CreateBackup:=False
   End With
   xlApp.Workbooks.Close
   Excel.Application.Quit
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

in above i'm continuously saving each excel sheet which is created for each word document file if any comments into a folder TEMP. After this i'm using below .VBS file to run :

Set objFSO = CreateObject("Scripting.FileSystemObject")

sFolder = "C:UsersDesktoptesttry" 
'Word.Visible = False 

If objFSO.FolderExists(sFolder & "temp") Then 
                objFSO.DeleteFolder sFolder & "temp"  
End If 

If Not objFSO.FolderExists(sFolder & "temp") Then 
                Set newfolder = objFSO.CreateFolder(sFolder & "temp")  
End If 

For Each f In objFSO.GetFolder(sFolder).Files
                If UCase(objFSO.GetExtensionName(f.Name)) = "RTF" Then 
                Set Word = CreateObject("Word.Application") 
Set WordDoc = Word.Documents.open(sFolder & GetObject(f)) 
                                Word.Run "exportcomments" 
                                Word.Quit  
                End if 
                Set WordDoc = Nothing  
Next 
Set Word = Nothing 

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add()  

objWorkbook.SaveAs(sFolder & "Results.xlsx")

---

As you can see from code i'm creating a new folder TEMP and placing all the excels into that folder. Along with that I'm creating a Result.xlsx sheet which will be used to merge all the Excels generated .. Please Note the above .vbs is one file Step 2 : Creating another .VBS which merges all the excel sheet into one

---

'****************************Excel Merge ***************************

Set objExcel = CreateObject("Excel.Application") 

sFolder = "C:UsersDesktoptesttry"  

strPathSrc = sFolder & "temp" ' Source files folder
strMaskSrc = "*.xlsx" ' Source files filter mask
iSheetSrc = 1 ' Sourse sheet index or name
strPathDst = sFolder & "Results.xlsx" ' Destination file
iSheetDst = 1 ' Destination sheet index or name

objExcel.Visible = True
Set objWorkBookDst = objExcel.Workbooks.Open(strPathDst)
Set objSheetDst = objWorkBookDst.Sheets(iSheetDst)
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.NameSpace(strPathSrc)
Set objItems = objFolder.Items()
objItems.Filter 64 + 128, strMaskSrc
objExcel.DisplayAlerts = False
For Each objItem In objItems
    Set objWorkBookSrc = objExcel.Workbooks.Open(objItem.Path)
    Set objSheetSrc = objWorkBookSrc.Sheets(iSheetSrc)
    GetUsedRange(objSheetSrc).Copy
    Set objUsedRangeDst = GetUsedRange(objSheetDst)
    iRowsCount = objUsedRangeDst.Rows.Count
    objWorkBookDst.Activate
    objSheetDst.Cells(iRowsCount + 1, 1).Select
    objSheetDst.Paste
    objWorkBookDst.Application.CutCopyMode = False
    objWorkBookSrc.Close
Next

Function GetUsedRange(objSheet)
    With objSheet
        Set GetUsedRange = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
    End With
End Function

---

Now this will create the final Result sheet with all the comments merged into one. My concern is : I tried to merge both the VBS into 1 but don't know why only the first part "Extraction" works and the second throws unknown error

Could please let me know if there's any simpler way to do this ?