Table of Contents for documenter?

[geoB]

In Access 2007:

I'm hoping someone already has a technique for generating a table of contents for database documenter output.

So far I've gotten the documenter output in Word and can format a portion of the page heading to be marked for a table of contents. [Replace all <tab> Page: # with nothing, replace "Query:" with formatted "Query:", etc.] When the TOC is generated there are duplicates for those objects occupying more than one page. It would be nice to only generate the TOC with unique headings.

Or is this an opportunity to teach myself some VBA for Word?

Thanks.

George

 

[geoB]

Okay, I took a run at coding a TOC for a documenter report. Assuming the documenter is saved as a Word document, here's some code that will mark the unique object items in the documenter for generating a table of contents. Other features include removing bold from the entire report and removing the hard-wired page numbers. There may be a more efficient or elegant ways to do this, but the following appears to work. Code goes in Word's NORMAL.DOTM. Once MarkTOC is run you can insert a TOC however you like. I add a page ahead of the documenter, then a section break, and start the documenter section at page 1.

[edit: Tried to add marking for "Sub" and "Function" inside objects, but the text strings are too unpredictable - they can show up in comments, etc.]

George

Sub MarkTOC()
Dim objects(), obj
ReDim TOC(6)
Dim strTOC As String
Dim i As Integer
Dim rng As Range

ActiveDocument.ShowGrammaticalErrors = False
ActiveDocument.ShowSpellingErrors = False
Application.ScreenUpdating = False
Set rng = ActiveDocument.Content
'turn off bold in case it's on
rng.Bold = False

'remove hard-wired page numbers
StripPageNumbers

'define array of possible objects in documentation
objects() = Array("Form", "Query", "Module", "Table", "Report", "Macro")
i = 1

'define array of objects that exist in documentation
For Each obj In objects()
    Set rng = ActiveDocument.Content
    If rng.Find.Execute(findtext:=obj & ":", Forward:=True) Then
        TOC(i) = obj
        i = i + 1
    End If
Next
i = i - 1
ReDim Preserve TOC(i)

'set a heading style for unique objects in documentation
For Each obj In TOC()
    Set rng = ActiveDocument.Content
    Do While rng.Find.Execute(findtext:=obj & ": ", Forward:=True)
        rng.Expand unit:=wdParagraph
        If rng.Text <> strTOC And InStr(rng.Text, obj) = 1 Then
            strTOC = rng.Text
            rng.Style = wdStyleHeading3
        End If
        rng.Collapse direction:=wdCollapseEnd
    Loop
Next
Application.ScreenUpdating = True
End Sub

Sub StripPageNumbers()
Dim length As Integer, doclen As Integer, i As Integer, j As Integer
Dim strPage As String, strChars As String, strPara As String
Dim strReplace As String
Dim rng As Range

'get number of pages
length = ActiveDocument.ComputeStatistics(wdStatisticPages)
'determine number of iterations to perform
doclen = Len(Trim(Str(length)))
strPage = "^tPage: "
strChars = "^#"
strPara = "^p"

'for each order of magnitude, remove existing hard-wired page number
For i = 1 To doclen
    Set rng = ActiveDocument.Content
    strReplace = strPage
    For j = 1 To i
        strReplace = strReplace & strChars
    Next j
    strReplace = strReplace & strPara
    rng.Find.Execute findtext:=strReplace, replacewith:=strPara, Forward:=True, Replace:=wdReplaceAll
Next i
End Sub