Update TableofContents Failed with Runtime Error

I have the code shown below and for some reason it loops through and updates the TableofContents but then it goes through and updates it again (or tries to) and then has an error. Can you help me figure it out?
The text in red is what causes the issue, when it runs the oToc.update

The text in orange loops through 1 time and is okay, and even though the table of contents count is 1 it loops again and that is when it has the error.

For Testing purposes please disregard the insert doc number and insert doc name sections at the bottom. Those work okay.


Option Explicit
Sub UpdateFields()
' UpdateFields Macro
Dim oStory As Object
Dim oToc As TableOfContents
Dim x
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update 'update fields in all stories
Next oStory

' ' Update all TOCs and reset paragraph styles to remove any magic tabs
' If ActiveDocument.TablesOfContents.Count >= 1 Then
' For x = 1 To ActiveDocument.TablesOfContents.Count
' With ActiveDocument.TablesOfContents(1)
' .Update
' '.Range.ParagraphFormat.Reset
' End With
'
' Next x
' End If
For Each oToc In ActiveDocument.TablesOfContents
oToc.Update 'update TOC's
Next oToc
Application.ScreenUpdating = True
'insert document number
Dim pathname As String
With ActiveDocument
If Len(.Path) = 0 Then
.Save
End If
' If Right(.Name, 1) = "x" Then
' pathName = Left$(.Name, (Len(.Name) - 5))
' Else
' pathName = Left$(.Name, (Len(.Name) - 4))
pathname = Left$(.Name, 8)
' End If
End With
' shows document number in message box
' MsgBox pathName
'checks for bookmark "docnum"
If ActiveDocument.Bookmarks.Exists("docnum") = True Then

Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks("docnum").Range
BMRange.Text = pathname
ActiveDocument.Bookmarks.Add "docnum", BMRange
'ActiveDocument.Bookmarks("docnum").Range.InsertAfter "Some text here"
'lbl_Exit:
' Exit Sub
Else: MsgBox "need to setup 'docnum' bookmark"
End If

'insert document title
Dim docname As String
Dim titlelen As String
With ActiveDocument
If Len(.Path) = 0 Then
.Save
End If
titlelen = InStr(.Name, ".") - 9
docname = Mid(.Name, 9, titlelen)
End With
' shows document title in message box
'MsgBox docName
'checks for bookmark "doctitle"
If ActiveDocument.Bookmarks.Exists("doctitle") = True Then
Dim BM1Range As Range
Set BM1Range = ActiveDocument.Bookmarks("doctitle").Range
BM1Range.Text = docname
ActiveDocument.Bookmarks.Add "doctitle", BM1Range
'ActiveDocument.Bookmarks("docnum").Range.InsertAfter "Some text here"
Else: MsgBox "need to setup 'doctitle' bookmark"
End If
End Sub

The problem appears to relate to the macroname. If you change the macroname to MyUpDateFields it works fine. It is probably a conflict with a similarly named macro or an internal VBA command. I suggest also that you modify the main field update code as follows:

Code:

---

    For Each oStory In ActiveDocument.StoryRanges
        oStory.Fields.Update
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Fields.Update
            Wend
        End If
    Next oStory

---

Thank you very much for your help! I will try both of those suggestions

One question I have though is why do you have the update section twice? (Red text in question)

For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory

The red version updates the main text body. The loop updates the other story ranges e.g. headers, footers, text boxes.

Thank you very much. That makes sense now. I appreciate the help!