Macro/Script help

[Nicole]

Do anyone know how to write a macro or script that generates a report which
includes the number of comments in a document, the author of the comments,
and also be able to track the changes in the document. I know nothing about
Macros or VB. Thanks.

 

[Jonathan West]

Do anyone know how to write a macro or script that generates a report
which
includes the number of comments in a document, the author of the comments,
and also be able to track the changes in the document. I know nothing
about
Macros or VB. Thanks.

You don't need a macro. Press Ctrl-P to bring up the print dialog. In the
"Print What" list, select Comments. Click OK.


--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org

 

[Nicole]

Thank you. I guess my question wasn't very clear. I need a script that will
count the number of comments and tracked changes in a word document and put
the results into another word document. Thanks.

 

[DA]

Hi Nicole

Try the following, probably not the most efficient way of doing it but this
should get you started. It will extract all comments and changes from your
doc and show you the results in a new document table.

Best of luck,
Dennis

----------------
Private Sub ExtractMyChanges()
Dim tblResults As Table
Dim astrMyChanges() As String
Dim strAuthor As String
Dim lngChangesCount As Long
Dim lngCommentsCount As Long
Dim lngPageCounter As Long
Dim lngCounter As Long
Dim lngArrayIdx As Long

'This will get you the counts for tracked changes & comments
lngChangesCount = ActiveDocument.Range.Revisions.Count
lngCommentsCount = ActiveDocument.Range.Comments.Count

If lngChangesCount + lngCommentsCount = 0 Then
MsgBox "This Document doesn't contain any changes"
Exit Sub
End If

'Prepare an array to hold the data
'The array holds - Designator "c" for comment or "t" for tracked change,
'the author, the change and the page number.
ReDim astrMyChanges(lngChangesCount + lngCommentsCount - 1, 3)

lngArrayIdx = 0
'Get Tracked Changes First
For lngCounter = 1 To lngChangesCount
With ActiveDocument
astrMyChanges(lngArrayIdx, 0) = "Change"
astrMyChanges(lngArrayIdx, 1) = .Range.Revisions(lngCounter).Author
If .Range.Revisions(1).FormatDescription <> "" Then
astrMyChanges(lngArrayIdx, 2) =
..Range.Revisions(1).FormatDescription
Else
astrMyChanges(lngArrayIdx, 2) =
..Range.Revisions(lngCounter).Range.Text
End If
astrMyChanges(lngArrayIdx, 3) =
..Range.Revisions(lngCounter).Range.Information(wdActiveEndPageNumber)
lngArrayIdx = lngArrayIdx + 1
End With
Next lngCounter

'Get Comments

For lngCounter = 1 To lngCommentsCount
With ActiveDocument
astrMyChanges(lngArrayIdx, 0) = "Comment"
astrMyChanges(lngArrayIdx, 1) = .Range.Comments(lngCounter).Author
astrMyChanges(lngArrayIdx, 2) = .Range.Comments(lngCounter).Range.Text
astrMyChanges(lngArrayIdx, 3) =
..Range.Comments(lngCounter).Reference.Information(wdActiveEndPageNumber)
lngArrayIdx = lngArrayIdx + 1
End With
Next lngCounter

'Write out to new document
Application.Documents.Add
Set tbleResults = ActiveDocument.Tables.Add(Selection.Range,
(lngChangesCount + lngCommentsCount + 1), 4)
With tbleResults
.Cell(1, 1).Range.InsertAfter "Type"
.Cell(1, 2).Range.InsertAfter "Author"
.Cell(1, 3).Range.InsertAfter "Change"
.Cell(1, 4).Range.InsertAfter "Page"
For lngArrayIdx = 0 To (lngChangesCount + lngCommentsCount - 1)
.Cell(lngArrayIdx + 2, 1).Range.InsertAfter
astrMyChanges(lngArrayIdx, 0)
.Cell(lngArrayIdx + 2, 2).Range.InsertAfter
astrMyChanges(lngArrayIdx, 1)
.Cell(lngArrayIdx + 2, 3).Range.InsertAfter
astrMyChanges(lngArrayIdx, 2)
.Cell(lngArrayIdx + 2, 4).Range.InsertAfter
astrMyChanges(lngArrayIdx, 3)
Next lngArrayIdx
End With
End Sub

 

[DA]

Sorry, I just noticed I pasted the wrong code.
Make sure you change this line

If .Range.Revisions(1).FormatDescription <> "" Then
astrMyChanges(lngArrayIdx, 2) =
.Range.Revisions(1).FormatDescription

to:

If .Range.Revisions(lngCounter).FormatDescription <> "" Then
astrMyChanges(lngArrayIdx, 2) =
..Range.Revisions(lngCounter).FormatDescription

 

[Nicole]

Thank you DA. However, I'm getting a compile error: invalid qualifier on
this code:
astrMyChanges(lngArrayIdx, 0).Cell(lngArrayIdx + 2, 2).Range.InsertAfter
astrMyChanges(lngArrayIdx, 1).Cell(lngArrayIdx + 2, 3).Range.InsertAfter
astrMyChanges(lngArrayIdx, 2).Cell(lngArrayIdx + 2, 4).Range.InsertAfter
astrMyChanges(lngArrayIdx, 3).

Can you help?

 

[DA]

Ok, lets try this one first. what I assume is happening is that when you
pasted the code you didn't merge some of the lines which wrapped in my post
(sorry I should have kept my lines shorter). If you're getting any red lines
in you code, stop and check that its not meant to be a continuation of the
line that sits above it.

Any, here's the code again.. this time using a syntax which keeps the column
width a bit tighter. Try this first and let me know if you still have
problems.

Private Sub ExtractMyChanges()
Dim tblResults As Table
Dim astrMyChanges() As String
Dim strAuthor As String
Dim lngChangesCount As Long
Dim lngCommentsCount As Long
Dim lngPageCounter As Long
Dim lngCounter As Long
Dim lngArrayIdx As Long

'This will get you the counts for tracked changes & comments
lngChangesCount = ActiveDocument.Range.Revisions.Count
lngCommentsCount = ActiveDocument.Range.Comments.Count

If lngChangesCount + lngCommentsCount = 0 Then
MsgBox "This Document doesn't contain any changes"
Exit Sub
End If

'Prepare an array to hold the data
'The array holds - Designator "c" for comment or "t" for tracked change,
'the author, the change and the page number.
ReDim astrMyChanges(lngChangesCount + lngCommentsCount - 1, 3)

lngArrayIdx = 0
'Get Tracked Changes First
For lngCounter = 1 To lngChangesCount
With ActiveDocument
astrMyChanges(lngArrayIdx, 0) = "Change"
astrMyChanges(lngArrayIdx, 1) = .Range.Revisions(lngCounter).Author
If .Range.Revisions(lngCounter).FormatDescription <> "" Then
astrMyChanges(lngArrayIdx, 2) = _
.Range.Revisions(lngCounter).FormatDescription
Else
astrMyChanges(lngArrayIdx, 2) = _
.Range.Revisions(lngCounter).Range.Text
End If
astrMyChanges(lngArrayIdx, 3) = _

..Range.Revisions(lngCounter).Range.Information(wdActiveEndPageNumber)
lngArrayIdx = lngArrayIdx + 1
End With
Next lngCounter

'Get Comments

For lngCounter = 1 To lngCommentsCount
With ActiveDocument
astrMyChanges(lngArrayIdx, 0) = _
"Comment"
astrMyChanges(lngArrayIdx, 1) = _
.Range.Comments(lngCounter).Author
astrMyChanges(lngArrayIdx, 2) = _
.Range.Comments(lngCounter).Range.Text
astrMyChanges(lngArrayIdx, 3) = _

..Range.Comments(lngCounter).Reference.Information(wdActiveEndPageNumber)
lngArrayIdx = lngArrayIdx + 1
End With
Next lngCounter

'Write out to new document
Application.Documents.Add
Set tbleResults = ActiveDocument.Tables.Add(Selection.Range, _
(lngChangesCount + lngCommentsCount + 1), 4)
With tbleResults
.Cell(1, 1).Range.InsertAfter "Type"
.Cell(1, 2).Range.InsertAfter "Author"
.Cell(1, 3).Range.InsertAfter "Change"
.Cell(1, 4).Range.InsertAfter "Page"
For lngArrayIdx = 0 To (lngChangesCount + lngCommentsCount - 1)
.Cell(lngArrayIdx + 2, 1).Range.InsertAfter _
astrMyChanges(lngArrayIdx, 0)
.Cell(lngArrayIdx + 2, 2).Range.InsertAfter _
astrMyChanges(lngArrayIdx, 1)
.Cell(lngArrayIdx + 2, 3).Range.InsertAfter _
astrMyChanges(lngArrayIdx, 2)
.Cell(lngArrayIdx + 2, 4).Range.InsertAfter _
astrMyChanges(lngArrayIdx, 3)
Next lngArrayIdx
End With
End Sub