View Single Post
 
Old 09-06-2016, 07:58 PM
DangerDraper DangerDraper is offline Windows 8 Office 2010 64bit
Novice
 
Join Date: Sep 2016
Posts: 3
DangerDraper is on a distinguished road
Default Help with VBA to Conditionally Accept Changes

Hi folks, I seeking a fresh set of eyes to this one.

I scripted together a Sub to loop through the Track Changes in a word doc, if the track change is either Formatting or changes to Field Code values. In theory this Sub worked and I trialled on a small document with success. However, in actual application within the team environment its become hit and miss..

The majority of Changes in these docs are Formatting or Field Codes, and often the important changes can be lost in the sea of unimportant ones.

Code:
Public Sub Test_Document_AcceptAll()

''    Dim RevisionTotal, RevisionAccepted As Integer
''    RevisionTotal = 0
''    RevisionAccepted = 0
    
    Select Case ThisDocument.NewBool
        Case True
            ActiveDocument.Revisions.AcceptAll
        Case Else
            On Error GoTo RevErr
            For Each NewRevision In ActiveDocument.Revisions
''                MsgBox "Revision Index: [" & NewRevision.Index & "]" & vbNewLine & "Revision Type: " & NewRevision.FormatDescription & ""
''                RevisionTotal = RevisionTotal + 1
                If Left(NewRevision.FormatDescription, 10) = "Formatted:" Then
                    NewRevision.Accept
''                    RevisionAccepted = RevisionAccepted + 1
                ElseIf Left(NewRevision.FormatDescription, 15) = "Formatted Table" Then
                    NewRevision.Accept
''                    RevisionAccepted = RevisionAccepted + 1
                ElseIf Left(NewRevision.FormatDescription, 11) = "Field Code:" Then
                    NewRevision.Accept
''                    RevisionAccepted = RevisionAccepted + 1
                Else
                End If
            Next NewRevision
            
''            MsgBox "" & RevisionAccepted & ": Revisions of a total " & RevisionTotal & " were Accepted..."
            
    End Select
    
RevErr: If Err.Number <> 5852 Then
            Exit Sub
        Else
            Err.Clear
        End If

End Sub
Basic Select Case to determine if this document is New, I keep all previous changes to the original template so I can show what/where things have changes, and if so the Accecpt All.

Both NewBool and NewRevision as Public and delcare elsewhere. I had an inkling that the error might lie with utilising the .FormatDescription property and hence why there is some de-bugging code in there which I've commented out.

What I found was that the majority of the time that messagebox returned "" for the .FormatDescription BUT still accepted the change (in the test document). Ran the Sub against the original template and worked fine; still returned "" and accepted the change. Feeling confident, rolled out the template revision to the team and it reverted back to hit and miss...

One thing I did discover through trial and error was that
Code:
Left(NewRevision.FormatDescription, 9) = "Formatted"
won't handle instances where the revision is "Formatted:" and "Formatted Table"
These have to be handled seperately, as I've done in the If/ElseIf

A fresh pair of eyes or some helpful insight would be greatly appreciated. Thansk in advance.
Reply With Quote