Using Word 97 with Track Changes enabled on a very long document, is
there a quick way to find the most recent addition or an addition made
on a known date?
Sorry if this double posted - can't find previous similar post
Here are two macros, one for each request. If you need instructions
for installing a macro in a template, see
http://www.gmayor.com/installing_macro.htm.
The first macro lists the revisions in the document by putting their
dates and page/line numbers in a table in a new document, and sorting
the table. The most recent revisions will be at the end of the table.
Word records the times only to the nearest minute, so there may be
several revisions shown as the same time and it may no be possible to
tell which one was made last.
Sub RevisionsByDateTime()
Dim srcDoc As Document, destDoc As Document
Dim oRev As Revision
Dim oTbl As Table
Dim nRows As Long
Set srcDoc = ActiveDocument
Set destDoc = Documents.Add
destDoc.Sections(1).Headers(wdHeaderFooterPrimary) _
.Range.Text = "Revisions in " & _
srcDoc.FullName
Set oTbl = destDoc.Tables.Add(Range:=destDoc.Range, _
numrows:=1, numcolumns:=3)
nRows = 1
With oTbl
.Cell(1, 1).Range.Text = "Date & Time"
.Cell(1, 2).Range.Text = "Page"
.Cell(1, 3).Range.Text = "Line"
For Each oRev In srcDoc.Revisions
.Rows.Add
nRows = nRows + 1
.Cell(nRows, 1).Range.Text = _
oRev.Date
.Cell(nRows, 2).Range.Text = oRev.Range.Information( _
wdActiveEndAdjustedPageNumber)
.Cell(nRows, 3).Range.Text = oRev.Range.Information( _
wdFirstCharacterLineNumber)
Next oRev
.Rows(1).HeadingFormat = True
.Sort excludeheader:=True, fieldnumber:=1, _
sortfieldtype:=wdSortFieldDate
End With
End Sub
The second macro lets you specify a date, and then lists the revisions
that were made on that date.
Sub TrackByDate()
Dim srcDoc As Document, destDoc As Document
Dim oRev As Revision
Dim strCkDate As String
Dim CkDate As Date
Dim RevType As Variant
RevType = Array("NoRevision", "Insert", "Delete", _
"Property", "ParagraphNumber", "DisplayField", _
"Reconcile", "Conflict", "Style", "Replace", _
"ParagraphProperty", "TableProperty", _
"SectionProperty", "StyleDefinition")
strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub
CkDate = CDate(strCkDate)
Set srcDoc = ActiveDocument
Set destDoc = Documents.Add
destDoc.Range.Text = "Revisions in " & _
srcDoc.FullName & " on " & strCkDate & _
vbCr & "Page" & vbTab & "Line" & vbCr & vbCr
For Each oRev In srcDoc.Revisions
If CDate(Left$(Format(oRev.Date, "MM/dd/yyyy"), 10)) _
= CkDate Then
destDoc.Range.InsertAfter _
oRev.Range.Information( _
wdActiveEndAdjustedPageNumber) & _
vbTab & oRev.Range.Information( _
wdFirstCharacterLineNumber) & _
vbTab & RevType(oRev.Type) & vbCr
End If
Next oRev
End Sub
