Copy Word Comments from multiple documents in one directory

[terrif]

Can anyone tell me how I can write the VBA code to create a new document and merge comments from multiple documents in one directory. I have the blow code, but it also includes the main document comments, but that is not needed. Also is there any way to add in the document name as well associated to the comments. So you would have the document name and then all the comments from that document. This would loop until it gets through the entire directory.

I am not VBA expert at all so any assistance on this would be much appreciated.


Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Dim i As Long

Const strFolder = "C:\Users\tefe\Desktop\Merge\"
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*.docx")
Do Until strFile = “”
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
Selection.InsertBreak Type:=wdPageBreak
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
'
'
'End Sub

Thanks,
TF

[SamT]

I moved this to the Word Help folder where it will better attract a response from a Word expert.

You need to be more specific in what you are trying to do. The Title mentions Excel Comments, but all the code relates to Word Documents, which excludes Excel.

You can ask a moderator to change the title for you.

[terrif]

Thanks. You are correct it is for Word. Sorry for the confusion. How to you contact a moderator?

[terrif]

Never mind, I figured out how to send a message to a moderator.

[gmayor]

From your vague description what I think you require is as follows. At least it should point the way forward.


Option Explicit

Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Dim i As Long
Dim oDoc As Document
Dim oComment As Comment

Const strFolder = "C:\Users\tefe\Desktop\Merge\"
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*.docx")
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
If Len(MainDoc.Range) > 1 Then
rng.InsertBreak Type:=wdPageBreak
End If
Set oDoc = Documents.Open(Filename:=strFolder & strFile, _
AddToRecentFiles:=False)
MainDoc.Range.InsertAfter oDoc.FullName & vbCr & vbCr
For Each oComment In oDoc.Comments
With oComment
MainDoc.Range.InsertAfter .Author & _
vbTab & .Date & _
vbTab & .Range & vbCr
End With
Next oComment
oDoc.Close SaveChanges:=wdDoNotSaveChanges
strFile = Dir$()
Loop
lbl_Exit:
Exit Sub
End Sub

[terrif]

Thanks Graham!!! You got it perfectly. This is exactly what I needed.