Can you suggest modifications to speed up this function?

What I am trying to do it to go through a list of Word documents and create
an array containing two parameters for each TOC entry. The first entry is
made up of the filename, a "|" as a delimiter and the TOC entry text
(includes all levels up to that point concatenated with a >). The second
entry of the array is the page number associated with the TOC entry. This
works as it is but it is painfully slow. I added the flag that is set when
the TOC Title paragraph is found to be able to stop the processing once all
of the TOC # entries had been processed and that has helped some but this is
still very slow. Is there a different approach that would speed this up?

Thanks.


Private Sub GetDocumentsHeadingsForFileInPath(wordFileName, wordFilePath)
Dim oApp As Object
Dim oDoc As Object
Dim oSec As Object
Dim NumSections As Integer
Dim foundTOC As Boolean
Dim st As String
Dim tocLastValues(9) As String

'Start Word and open the document.
Set oApp = CreateObject("Word.Application")
On Error Resume Next
Set oDoc = oApp.Documents.Open(wordFilePath)
If Not oDoc Is Nothing Then
'Iterate each paragraph in the document to find the table of content
entries
'Get their level, text and page values
'Once you have found the Table of Contents, stop at the next style
that is not a TOC #

NumSections = oDoc.Paragraphs.Count
foundTOC = False
For i = 1 To NumSections
Set oSec = oDoc.Paragraphs(i)
If Not oSec Is Nothing Then
st = oSec.Style
If st = "TOC Title" Then
foundTOC = True
ElseIf Left(st, 3) = "TOC" Then
currentLevel = Right(st, 1)
currenttext = Split(oSec.Range.Text, vbTab)(0)
currentPageNo = Split(oSec.Range.Text, vbTab)(1)
currenttext = GetFullTextForLevel(tocLastValues,
currentLevel, currenttext)
'Debug.Print "Level: " & currentLevel & " Text: " &
currenttext & " Page: " & currentPageNo
allValues(0, noEntries) = wordFileName & "|" & currenttext
allValues(1, noEntries) = currentPageNo
noEntries = noEntries + 1
ElseIf foundTOC Then
Exit For
End If
End If
Next
End If

'Close the document without saving changes and quit Word.
On Error Resume Next
oDoc.Close
oApp.Quit
Set oSec = Nothing
Set oDoc = Nothing
Set oApp = Nothing
End Sub

Private Function GetFullTextForLevel(currentValues, thisLevel, levelText)
Dim i As Integer
Dim tempText As String

tempText = ""

'blank out everything above this level
For i = thisLevel To 9
currentValues(i) = ""
Next

'set this level's text
currentValues(thisLevel) = levelText

'build the string for this level
For i = 1 To thisLevel - 1
tempText = tempText & currentValues(i) & " > "
Next
tempText = tempText & currentValues(thisLevel)

GetFullTextForLevel = tempText
End Function

Russ
Thu Oct 18 10:51:58 PDT 2007

Lori,
Using a counter to go through each paragraph is usually slower than a for
each object of doc object collection, because Word seems to always start
counting from the beginning in each numbered loop.
Speaking of collections, did you read VBA Help on TOC collections?

I cut and pasted this:
=========Quote
TablesOfContents Collection Object
See Also Properties Methods Events

Documents collection (Document object)
TablesOfContents collection (TableOfContents object)
Multiple objects
A collection of TableOfContents objects that represent the tables of
contents in a document.
Using the TablesOfContents Collection
Use the TablesOfContents property to return the TablesOfContents collection.
The following example inserts a table of contents entry that references the
selected text in the active document.
ActiveDocument.TablesOfContents.MarkEntry Range:=Selection.Range, _
Level:=2, Entry:="Introduction"
Use the Add method to add a table of contents to a document. The following
example adds a table of contents at the beginning of the active document.
The example builds the table of contents from all paragraphs styled as
either Heading 1, Heading 2, or Heading 3.
Set myRange = ActiveDocument.Range(Start:=0, End:=0)
ActiveDocument.TablesOfContents.Add Range:=myRange, _
UseFields:=False, UseHeadingStyles:=True, LowerHeadingLevel:=3, _
UpperHeadingLevel:=1
Use TablesOfContents(index), where index is the index number, to return a
single TableOfContents object. The index number represents the position of
the table of contents in the document. The following example updates the
page numbers of the items in the first table of figures in the active
document.
ActiveDocument.TablesOfContents(1).UpdatePageNumbers
=======UnQuote

You might just address TablesOfContents(1) and work with that range.


> What I am trying to do it to go through a list of Word documents and create
> an array containing two parameters for each TOC entry. The first entry is
> made up of the filename, a "|" as a delimiter and the TOC entry text
> (includes all levels up to that point concatenated with a >). The second
> entry of the array is the page number associated with the TOC entry. This
> works as it is but it is painfully slow. I added the flag that is set when
> the TOC Title paragraph is found to be able to stop the processing once all
> of the TOC # entries had been processed and that has helped some but this is
> still very slow. Is there a different approach that would speed this up?
>
> Thanks.
>
>
> Private Sub GetDocumentsHeadingsForFileInPath(wordFileName, wordFilePath)
> Dim oApp As Object
> Dim oDoc As Object
> Dim oSec As Object
> Dim NumSections As Integer
> Dim foundTOC As Boolean
> Dim st As String
> Dim tocLastValues(9) As String
>
> 'Start Word and open the document.
> Set oApp = CreateObject("Word.Application")
> On Error Resume Next
> Set oDoc = oApp.Documents.Open(wordFilePath)
> If Not oDoc Is Nothing Then
> 'Iterate each paragraph in the document to find the table of content
> entries
> 'Get their level, text and page values
> 'Once you have found the Table of Contents, stop at the next style
> that is not a TOC #
>
> NumSections = oDoc.Paragraphs.Count
> foundTOC = False
> For i = 1 To NumSections
> Set oSec = oDoc.Paragraphs(i)
> If Not oSec Is Nothing Then
> st = oSec.Style
> If st = "TOC Title" Then
> foundTOC = True
> ElseIf Left(st, 3) = "TOC" Then
> currentLevel = Right(st, 1)
> currenttext = Split(oSec.Range.Text, vbTab)(0)
> currentPageNo = Split(oSec.Range.Text, vbTab)(1)
> currenttext = GetFullTextForLevel(tocLastValues,
> currentLevel, currenttext)
> 'Debug.Print "Level: " & currentLevel & " Text: " &
> currenttext & " Page: " & currentPageNo
> allValues(0, noEntries) = wordFileName & "|" & currenttext
> allValues(1, noEntries) = currentPageNo
> noEntries = noEntries + 1
> ElseIf foundTOC Then
> Exit For
> End If
> End If
> Next
> End If
>
> 'Close the document without saving changes and quit Word.
> On Error Resume Next
> oDoc.Close
> oApp.Quit
> Set oSec = Nothing
> Set oDoc = Nothing
> Set oApp = Nothing
> End Sub
>
> Private Function GetFullTextForLevel(currentValues, thisLevel, levelText)
> Dim i As Integer
> Dim tempText As String
>
> tempText = ""
>
> 'blank out everything above this level
> For i = thisLevel To 9
> currentValues(i) = ""
> Next
>
> 'set this level's text
> currentValues(thisLevel) = levelText
>
> 'build the string for this level
> For i = 1 To thisLevel - 1
> tempText = tempText & currentValues(i) & " > "
> Next
> tempText = tempText & currentValues(thisLevel)
>
> GetFullTextForLevel = tempText
> End Function

--
Russ

drsmN0SPAMikleAThotmailD0Tcom.INVALID

LoriM
Thu Oct 18 13:01:01 PDT 2007

Thank you very much Russ. That makes a huge difference.