There is a way to change the author of revisions in a Word document? - vba

Question

I would like to know if there is a way to change the author of revisions in a document, I've found the way to change the author of comments but no for the revisions part. I've tried to find a property/method in the Revisions.object documentation to change that but I find nothing.
As I said I've already tried to do this:
Sub ChangeCommentCreator()
Dim I As Long
Dim Novo As String
Dim Corto As String
If Selection.Comments.Count = 0 Then
MsgBox "No comments in your selection!", vbInformation, "Alerta"
Exit Sub
End If
Novo = InputBox("New author name?", "Alerta")
Corto = InputBox("New author initials?", "Alerta")
If Novo = "" Or Corto = "" Then
MsgBox "The author name/initials can’t be empty.", vbInformation, "Alerta"
Exit Sub
End If
With Selection
For I = 1 To .Comments.Count
.Comments(I).Author = Novo
.Comments(I).Initial = Corto
Next I
End With
End Sub
I'm going in the right way or there is just no way to change this?

Answer 1

Revisions automatically use the selected User Name in the UI. The language reference for the Revisions's Author property states:
Returns the name of the user who made the specified tracked change. Read-only String.
So there's no direct way using VBA and the object model to change that.
It is possible to change it by editing the underlying Word Open XML, as illustrated in the code that follows. I notice, however, that this appears to confuse Word - after running the macro no revisions are recognized in the document. Only after saving, closing and re-opening does Word "see" the revisions, again.
Sub ChangeAuthorName()
Dim sWOOXML As String
Dim findAuthor As String
Dim replaceAuthor As String
findAuthor = "w:author=" & Chr(34) & "Cindy Meister" & Chr(34)
replaceAuthor = "w:author=" & Chr(34) & "unknown" & Chr(34)
sWOOXML = ActiveDocument.content.WordOpenXML
sWOOXML = Replace(sWOOXML, findAuthor, replaceAuthor)
ActiveDocument.content.InsertXML sWOOXML
End Sub
Note that this will likely also change the author's name for comments. The more "elegant" way to do this would be to leverage an XML parser (such as MSXML) and work with the specific nodes. Or even use a package that works on the closed document and edits the Word Open XML. But this is the simplest way using straight Word VBA.

Answer 2

I picked up Cindy Meister's suggestion and cleared the Word confusion that he reported. All revision and comment authors, creators, and lastmodied will be changed by the name entered.
Sub ChangeCommentAndRevisionAuthor()
Dim j, jmax As Long
Dim Author(99) As String
Dim WXML, NewAuthor, FindAuthor, ReplaceAuthor As String
Dim BNew, StatusTrackRevision As Boolean
Dim Rev As Revision
Dim Cmt As Comment
' set some variables and put trackrevision to false
StatusTrackRevision = ActiveDocument.TrackRevisions
ActiveDocument.TrackRevisions = False
jmax = -1
' checks and input new author name
If ActiveDocument.Range.Revisions.count = 0 Then
MsgBox "No revisions in your document!", vbInformation, "Change comment and revision author"
Exit Sub
End If
NewAuthor = InputBox("New author name?", "Change comment and revision author")
If NewAuthor = "" Then
MsgBox "The author name can’t be empty.", vbInformation, "Change comment and revision author"
Exit Sub
End If
' Loop through all revisions and get all authors of revisions (maximum 100)
With ActiveDocument.Range
If .Revisions.count > 1000 Then
If MsgBox("The number of revisions it large. " & .Revisions.count & vbCr & " Do you want to continue?", vbOKCancel + vbQuestion + vbDefaultButton2, "Change comment and revision author") > 1 Then Exit Sub
End If
For Each Rev In .Revisions
BNew = True
For j = 0 To jmax
If Author(j) = Rev.Author Then
BNew = False
Exit For
End If
Next
If BNew Then
jmax = jmax + 1
If jmax > UBound(Author) Then jmax = UBound(Author)
Author(jmax) = Rev.Author
End If
Next
' change all comments
For Each Cmt In ActiveDocument.Comments
Cmt.Author = NewAuthor
Cmt.Initial = NewAuthor
Next
End With
' read XML and change all authors to the new author
WXML = ActiveDocument.Content.WordOpenXML
For j = 0 To jmax
WXML = Replace(WXML, "w:author=" & Chr(34) & Author(j) & Chr(34), "w:author=" & Chr(34) & NewAuthor & Chr(34))
Next
' change "last modified by" to new author
WXML = Replace(WXML, "<cp:lastModifiedBy>" & ActiveDocument.BuiltInDocumentProperties(7) & "</cp:lastModifiedBy>", "<cp:lastModifiedBy>" & NewAuthor & "</cp:lastModifiedBy>")
' save modified XML
ActiveDocument.Content.InsertXML WXML
' Change Creator of Document to new author
ActiveDocument.BuiltInDocumentProperties(3) = NewAuthor
' restore original status of track revision
ActiveDocument.TrackRevisions = StatusTrackRevision
End Sub