Insertion and deletion counter

Hi VBA gang,

A new week, a new headache. I absolutely cannot work out why I'm getting a "Run-time error '5852'. Requested object is not available" error on this one. Thought it was a simple code, but no! The debugger seems to flip out on the select case part of the code. Any ideas why this simple code isn't working? All I'm trying to do is count tracked insertions and deletions.

Code:

---

Sub InDel_Counter()

Dim rvcnt, rvcnt2, a As Long
Dim oRevision As Revision
   
    rvcnt = ActiveDocument.Revisions.Count
   
    rvcnt2 = 0
   
For Each oRevision In ActiveDocument.Revisions
    Select Case oRevision.Type
        Case wdRevisionInsert, wdRevisionDelete
            With oRevision
                If .Type = wdRevisionInsert Or wdRevisionDelete Then rvcnt2 = rvcnt2 + 1
            End With
    End Select
Next oRevision
       
MsgBox "There are " & rvcnt2 & " tracked insertions and deletions.", vbOKOnly
   
End Sub

---

*Updated to add:*

I've even tried a much more convoluted way, but to no avail:

Code:

---

Sub InDel_Counter()

Dim rvcnt, rvcnt2, a As Long
Dim oRevision As Revision
Dim tDoc As Document


Set tDoc = ActiveDocument
   
    rvcnt = tDoc.Revisions.Count
   
    rvcnt2 = 0
   
For Each oRevision In tDoc.Revisions
    If oRevision.Type = wdRevisionConflict Or wdNoRevision Or wdRevisionCellDeletion Or wdRevisionCellInsertion Or wdRevisionCellMerge _
        Or wdRevisionCellSplit Or wdRevisionConflict Or wdRevisionConflictDelete Or wdRevisionConflictInsert Or wdRevisionDisplayField _
        Or wdRevisionMovedFrom Or wdRevisionMovedTo Or wdRevisionParagraphNumber Or wdRevisionParagraphProperty Or wdRevisionProperty _
        Or wdRevisionReconcile Or wdRevisionReplace Or wdRevisionSectionProperty Or wdRevisionStyle Or wdRevisionStyleDefinition _
        Or wdRevisionTableProperty Then
            GoTo NextoRevision
    ElseIf oRevision.Type = wdRevisionDelete Or wdRevisionInsert Then
        rvcnt2 = rvcnt2 + 1
    Else
        GoTo NextoRevision
    End If
NextoRevision:
Next
       
MsgBox "There are " & rvcnt2 & " tracked insertions and deletions.", vbOKOnly
   
End Sub

---

Your code runs without error here.

Hmmmm, interesting. Could it be crashing if it's a massive document with lots of changes?

Wonder if there's a way to break it up so it doesn't crash?

Maybe you can figure out what the error is by trying to skip it.

Just code reading ...

Code:

---

Sub InDel_Counter()

Dim rvcnt As Long, rvcnt2 as Long, a As Long  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim oRevision As Revision
   
    rvcnt = ActiveDocument.Revisions.Count
   
    rvcnt2 = 0
   
For Each oRevision In ActiveDocument.Revisions
    Select Case oRevision.Type
        Case wdRevisionInsert, wdRevisionDelete
          rvcnt2 = rvcnt2 + 1  ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    End Select
Next oRevision
       
MsgBox "There are " & rvcnt2 & " tracked insertions and deletions.", vbOKOnly
   
End Sub

---

Or even:

Code:

---

Sub InDel_Counter()
Dim Rvn As Revision, lRvn As Long
For Each Rvn In ActiveDocument.Revisions
  Select Case Rvn.Type
    Case wdRevisionInsert, wdRevisionDelete: lRvn = lRvn + 1
  End Select
Next
MsgBox "There are " & lRvn & " tracked insertions and deletions.", vbOKOnly
End Sub

---

That is not the problem. I know there are documents (I've got some, I assume with revisions in a header, footer, footnote or somewhere else), where ActiveDocument.Revisions is a collection that may contain non-existing-elements. You can not find them with "if myRevision is nothing", and you can not access anything inside. The debugger says the item is deleted. And if those "deleted items" are there, they always are the last ones in the collection.

That suggests you've got a corrupt document.