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(wdActiveEndAdjustedPageNum ber)
.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.