You could do that with a macro, such as:
Sub Demo()
Application.ScreenUpdating = False
Dim StrUser As String, StrCompany As String, i As Long, Rng As Range, RngMv As Range, bTrk As Boolean
StrUser = Application.UserName: StrCompany = "My Company"
Application.UserName = StrCompany
With ActiveDocument
On Error Resume Next
bTrk = .TrackRevisions
.TrackRevisions = True
For i = 1 To .Revisions.Count
Set Rng = .Revisions(i).Range
With .Revisions(i)
If .Author <> StrCompany Then
If .Type = wdRevisionDelete Then
.Reject
Rng.Delete
End If
If .Type = wdRevisionInsert Then
Rng.Copy
Rng.Collapse wdCollapseEnd
.Reject
Rng.Paste
End If
End If
End With
Next
For i = .Revisions.Count To 1 Step -1
Set Rng = .Revisions(i).Range
With .Revisions(i)
If .Author <> StrCompany Then
If .Type = wdRevisionMovedFrom Then
Set RngMv = .MovedRange
.Reject
Rng.Cut
RngMv.Paste
End If
End If
End With
Next
.TrackRevisions = bTrk
End With
Application.UserName = StrUser
Application.ScreenUpdating = True
End Sub
The above macro deals with insertions, deletions and moves. There are numerous other revision types that might also need to be dealt with - I'll leave it to your organization to code for them. Change 'My Company' to whatever name you want to use.
Cheers
Paul Edstein
[MS MVP - Word]
