Help with VBA to Conditionally Accept Changes

DangerDraper · #1 09-06-2016, 07:58 PM

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.

gmayor · #2 09-06-2016, 09:13 PM

Without a document to evaluate, and the rest of the code for the process, it is difficult to judge, but based upon what you have presented, I would suggest something like:

Code:

Public Sub Test_Document_AcceptAll(newRevision As Revision, _
                                   newbool As Boolean)
    If newbool = True Then
        ActiveDocument.Revisions.AcceptAll
    Else
        On Error GoTo RevErr
        Select Case True
            Case Left(newRevision.FormatDescription, 15) = "Formatted Table": newRevision.Accept
            Case Left(newRevision.FormatDescription, 10) = "Formatted:": newRevision.Accept
            Case Left(newRevision.FormatDescription, 11) = "Field Code:": newRevision.Accept
        End Select
    End If
lbl_Exit:
    Exit Sub
RevErr:
    If Err.Number <> 5852 Then
        Err.Clear
        GoTo lbl_Exit
    Else
        Err.Clear
        Resume
    End If
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Conditionally playing a wave file	blackjack	Excel Programming	1	10-11-2014 06:25 AM
Insert a text conditionally	deboer	Word	1	05-04-2014 03:35 PM
changing font size conditionally	newton.rogers	Excel	1	03-18-2014 12:57 PM
How to conditionally format this?	g4tv4life	Excel	2	03-13-2014 10:58 AM
Macro to conditionally delete rows	Steve_D	Excel	2	08-24-2012 09:37 PM