Help combine 2 macros (merge comments from several word docs and export it to excel)

[ahalya]

I have following code for merging comments from several documents simultaneously and exporting it to excel with details (Note - This code is from VBA express or some other forums). Can some help to combine these macros into one and be able to do the subject?

Sub MergeDocuments()
    Dim iFile As Integer
    Dim sMergePath As String
    Dim strFile As String
    Dim i As Long
    sMergePath = MergeFolder
    If sMergePath = vbNullString Then Exit Sub
     
    strFile = Dir$(sMergePath & "*.doc")
    While strFile <> ""
        MergeDocument sMergePath & strFile
        i = i + 1
        strFile = Dir$()
    Wend
    MsgBox ("The code finished merging: " & i & " documents")
End Sub

Sub MergeDocument(sPath As String)
    Application.ScreenUpdating = False
    ActiveDocument.Merge FileName:=sPath, _
    MergeTarget:=wdMergeTargetSelected, DetectFormatChanges:=True, _
    UseFormattingFrom:=wdFormattingFromPrompt, AddToRecentFiles:=False
End Sub

Function MergeFolder() As String
    MergeFolder = vbNullString
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder of the merge files"
        If .Show = -1 Then
            MergeFolder = .SelectedItems(1) & Chr(92)
        End If
    End With
End Function

Sub exportComments_Modified()
' Exports comments from a MS Word document to Excel with page/section number and selected text, comments, reviewer name and date 
' Need to set a VBA reference to latest e.g., "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 strTemp
Dim myRange As Range
 
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add 'create a new workbook
With xlWB.Worksheets(1)
 
' Create Heading
    HeadingRow = 1
    .Cells(HeadingRow, 1).Formula = "SL-No"
    .Cells(HeadingRow, 2).Formula = "Page"
    .Cells(HeadingRow, 3).Formula = "Paragraph"
    .Cells(HeadingRow, 4).Formula = "Selected Text"
    .Cells(HeadingRow, 5).Formula = "Comment"
    .Cells(HeadingRow, 6).Formula = "Author"
    .Cells(HeadingRow, 7).Formula = "Date"
     
    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
        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, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
        .Cells(i + HeadingRow, 3).Value = strSection
        .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Scope
        .Cells(i + HeadingRow, 5).Formula = ActiveDocument.Comments(i).Range
        .Cells(i + HeadingRow, 6).Formula = ActiveDocument.Comments(i).Author
        .Cells(i + HeadingRow, 7).Formula = Format(ActiveDocument.Comments(i).Date, "MM/dd/yyyy")
        .Cells(i + HeadingRow, 8).Formula = ActiveDocument.Comments(i).Range.ListFormat.ListString
    Next i
End With
 
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
 
Function ParentLevel(Para As Word.Paragraph) As String
'From Tony Jollans
' Finds the first outlined numbered paragraph above the given paragraph object
    Dim ParaAbove As Word.Paragraph
    Set ParaAbove = Para
  
    If Para.Range.ParagraphStyle Is Nothing Then
        GoTo Skip
    End If
 
    sStyle = Para.Range.ParagraphStyle
    sStyle = Left(sStyle, 4)
   
    If sStyle = "Head" Then
        GoTo Skip
    End If
   
    Count = 0
 
    Do While ParaAbove.OutlineLevel = Para.OutlineLevel
        On Error Resume Next
        'Count = Count + 1
        Set ParaAbove = ParaAbove.Previous
   
        If Err Then
            Exit Do
        End If
       
        'If Count > 150 Then
        '    Exit Do
        'End If
       
    Loop
 
Skip:
 
    strTitle = ParaAbove.Range.Text
    strTitle = Left(strTitle, Len(strTitle) - 1)
 
    ParentLevel = ParaAbove.Range.ListFormat.ListString & " " & strTitle
 
End Function

[macropod]

Perhaps you could explain the point of the document merging? If all you want to do is export the comments from several documents to Excel, there is no need to merge them beforehand.


That said, all you need do is insert:
Call exportComments_Modified
MsgBox "Comments exported"
after:
MsgBox ("The code finished merging: " & i & " documents")

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses its structure.

[ahalya]

Thanks for reply and suggestion

[ahalya]

Reason for merging comments from several reviewed documents are:
My company authors sends and receive comments from several reviewers. So, merging comments by authors and exporting it is very useful instead of each one exporting comments and sending it to author. Comments are sequential by the page number. Authors don't have to go back and forth while addressing comments from each reviewer in word/excel.