mvan231
01-15-2016, 07:42 AM
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 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