Macro for word to count Track Changes (Sub GetTCStats()) leads to errors

[ariellata]

Hello,
I need help in VB since I am not a coder, please bare with me if I do not describe well the issue.

Translation professionals use Sub GetTCStats() Macro for Word in order to count insertions and deletions made in a Word document with Track Changes.

In some documents, it does not work at all, and yields "Requested object is not available" (Run-time error '5852'). When I open the debugging dialog, it highlights the line "Select Case oRevision.Type"

In other documents I tested, I do not receive this error, or any other, and it does appear "to work", but when I "step into" and hover this specific line ("Select Case oRevision.Type") I see it has a "oRevision.Type = <Object variable or With block variable not set>" comment in the tooltip.

how can we update this to work in all cases?

Very grateful to you all, ariellata


Macro:

Sub GetTCStats()
Dim lInsertsWords As Long
Dim lInsertsChar As Long
Dim lDeletesWords As Long
Dim lDeletesChar As Long
Dim sTemp As String
Dim oRevision As Revision
lInsertsWords = 0
lInsertsChar = 0
lDeletesWords = 0
lDeletesChar = 0
For Each oRevision In ActiveDocument.Revisions
Select Case oRevision.Type
Case wdRevisionInsert
lInsertsChar = lInsertsChar + Len(oRevision.Range.Text)
lInsertsWords = lInsertsWords + oRevision.Range.Words.Count
Case wdRevisionDelete
lDeletesChar = lDeletesChar + Len(oRevision.Range.Text)
lDeletesWords = lDeletesWords + oRevision.Range.Words.Count
End Select
Next oRevision
sTemp = "Insertions" & vbCrLf
sTemp = sTemp & " Words: " & lInsertsWords & vbCrLf
sTemp = sTemp & " Characters: " & lInsertsChar & vbCrLf
sTemp = sTemp & "Deletions" & vbCrLf
sTemp = sTemp & " Words: " & lDeletesWords & vbCrLf
sTemp = sTemp & " Characters: " & lDeletesChar & vbCrLf
MsgBox sTemp
End Sub

[gmayor]

Without an example document that fails, it is difficult to determine why you get the error, but if you add an error trap before the 'For Each' line i.e.

On Error Resume Next

the error should be suppressed. An example document, would help determine a more robust error trap.

[ariellata]

Without an example document that fails, it is difficult to determine why you get the error, but if you add an error trap before the 'For Each' line i.e.

On Error Resume Next

the error should be suppressed. An example document, would help determine a more robust error trap.

Hi gmayor,
thank you for your kind reply. the document that produced the error is under confidentiality, so I sadly cannot share it.
since it does not happen a lot, I got no other example to share.
I do know, however, just by googling, that there are many translators out there experiencing the same.

To conclude - will that supress the error? - not sure I added the line in the right position in the code...

Thank you so much!

Sub GetTCStats()
Dim lInsertsWords As Long
Dim lInsertsChar As Long
Dim lDeletesWords As Long
Dim lDeletesChar As Long
Dim sTemp As String
Dim oRevision As Revision
lInsertsWords = 0
lInsertsChar = 0
lDeletesWords = 0
lDeletesChar = 0
On Error Resume Next
For Each oRevision In ActiveDocument.Revisions
Select Case oRevision.Type
Case wdRevisionInsert
lInsertsChar = lInsertsChar + Len(oRevision.Range.Text)
lInsertsWords = lInsertsWords + oRevision.Range.Words.Count
Case wdRevisionDelete
lDeletesChar = lDeletesChar + Len(oRevision.Range.Text)
lDeletesWords = lDeletesWords + oRevision.Range.Words.Count
End Select
Next oRevision
sTemp = "Insertions" & vbCrLf
sTemp = sTemp & " Words: " & lInsertsWords & vbCrLf
sTemp = sTemp & " Characters: " & lInsertsChar & vbCrLf
sTemp = sTemp & "Deletions" & vbCrLf
sTemp = sTemp & " Words: " & lDeletesWords & vbCrLf
sTemp = sTemp & " Characters: " & lDeletesChar & vbCrLf
MsgBox sTemp
End Sub

[gmayor]

It should suppress the error, though the counts may no longer be correct - try the revised code on your errant document.

I notice that you mentioned translators. If this is not an English language document, what is the language involved. Language issues are relevant, though I don't see any obvious language related issue.

[ariellata]

Thanks gmayor,
the code made my Word 'not responding' and I had to stop it from the task manager.
the language is English, and it is "real" track changes, and not just "make believe" colored text.
I wish I could send it. I'm sure you could figure this out.
Is there anyway in which I can debug this to provide you with more information?
thank you for trying to help. ariellata.

[gmayor]

Try the following which selects the corrections as it processes them. If it crashes the item that caused the error should be highlighted

Sub GetTCStats()

Dim lInsertsWords As Long
Dim lInsertsChar As Long
Dim lDeletesWords As Long
Dim lDeletesChar As Long
Dim lRev As Long
Dim sTemp As String
Dim oRevision As Revision
Dim bTrack As Boolean

    On Error GoTo err_Handler
    bTrack = ActiveDocument.TrackRevisions
    ActiveDocument.TrackRevisions = False
    lInsertsWords = 0
    lInsertsChar = 0
    lDeletesWords = 0
    lDeletesChar = 0
    For lRev = ActiveDocument.Revisions.Count To 1 Step -1
        Set oRevision = ActiveDocument.Revisions(lRev)
        oRevision.Range.Select
        Select Case oRevision.Type
            Case wdRevisionInsert
                lInsertsChar = lInsertsChar + Len(oRevision.Range.Text)
                lInsertsWords = lInsertsWords + oRevision.Range.Words.Count
            Case wdRevisionDelete
                lDeletesChar = lDeletesChar + Len(oRevision.Range.Text)
                lDeletesWords = lDeletesWords + oRevision.Range.Words.Count
            Case Else
        End Select
        DoEvents
    Next lRev
    sTemp = "Insertions" & vbCrLf
    sTemp = sTemp & " Words: " & lInsertsWords & vbCrLf
    sTemp = sTemp & " Characters: " & lInsertsChar & vbCrLf
    sTemp = sTemp & "Deletions" & vbCrLf
    sTemp = sTemp & " Words: " & lDeletesWords & vbCrLf
    sTemp = sTemp & " Characters: " & lDeletesChar & vbCrLf
    MsgBox sTemp
lbl_Exit:
    ActiveDocument.TrackRevisions = bTrack
    Set oRevision = Nothing
    Exit Sub
err_Handler:
    Beep
    MsgBox "The process encountered an uncorrectable error"
    Err.Clear
    GoTo lbl_Exit
End Sub

[ariellata]

Hi again,
and much thanks for the updated code.
I received "The process encountered an uncorrectable error".
What else can I do?
ariellata

[gmayor]

Without a sample of the document that causes the error, it is difficult to guess what the problem is that is causing it.

[ariellata]

I appreciate your efforts, and I sadly will wait till the next faulty document-macro results.
I do not think I may expose my client...
thank you again, ariellata