Add table of contents from mail merge

[Homegrownandy]

Including a table of contents with a mail merge from access comes with a lot of errors. So I've created all my documents, they all have the correct headings and numbering.



I would like a macro to go through a folder and insert a table of contents on page 2. Page 2 can be inserted as a new page if needs be. This is what I have right now:

Sub DoVBRoutineNow()
Dim file
Dim path As String

path = "Y:\Name\Health & Safety\Word Docs\"
file = Dir(path & "*.doc")
Do While file <> ""
Documents.Open Filename:=path & file
Call secondSubRoutine
ActiveDocument.Save
ActiveDocument.Close
file = Dir()
Loop
End Sub

Sub secondSubRoutine()
   Application.Templates( _
        "C:\Users\ah\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
        ).BuildingBlockEntries("Automatic Table 1").Insert Where:=Selection.Range _
        , RichText:=True
    Selection.TypeParagraph
End Sub

Nothing happens when clicked. I'm probably doing something wrong. The second sub routine was created when I clicked record macro in word and then added the table of contents. I then copied this code into the excel workbook where the code is living.

If someone could help id really appreciate it.

[Homegrownandy]

Sub DoVBRoutineNow()
Dim file
Dim path As String

path = "Y:\UU DWI Undertaking SR's\Health & Safety\Word Docs\"
file = Dir(path & "*.docx")
Do While file <> ""
Documents.Open Filename:=path & file
Call secondSubRoutine
ActiveDocument.Save
ActiveDocument.Close
file = Dir()
Loop
End Sub

Sub secondSubRoutine()
Dim rangeWord As Integer
  Set rangeWord = ActiveDocument.Range(Start:=0, End:=0)
    ActiveDocument.TablesOfContents.Add rangeWord, _
                                    UseFields:=True, _
                                    UseHeadingStyles:=True, _
                                    LowerHeadingLevel:=3, _
                                    UpperHeadingLevel:=1
End Sub

Trying this now. Getting the error object required on this line :

  Set rangeWord = ActiveDocument.Range(Start:=0, End:=0)

I've put the definition of integer in myself. apparently incorrectly.

[orange]

Andy,

I haven't used vba with Word for a very long time. I found this via Google. I hope it is of some value to you.

[Homegrownandy]

Thanks, Can you see the issue with my reference?

[Homegrownandy]

Sub secondSubRoutine()
Dim rangeWord As Integer
   rangeWord = ActiveDocument.Range(Start:=0, End:=0)
    ActiveDocument.TablesOfContents.Add rangeWord, _
                                    UseFields:=True, _
                                    UseHeadingStyles:=True, _
                                    LowerHeadingLevel:=3, _
                                    UpperHeadingLevel:=1
End Sub

Type mismatch now on "rangeWord" on this line:

  ActiveDocument.TablesOfContents.Add rangeWord,

[Homegrownandy]

I have just asked here also: http://www.ozgrid.com/forum/newthrea...ewthread&f=158

[ssanfu]

Disclaimer: I have never worked with MS Word automation, but why is rangeword declared as an integer?
I would expect it to be of type Range.

Look at the provided example (from the link orange posted)

 Dim myRange as Range    '<<-- I added this line. 

Set myRange = ActiveDocument.Range(0, 0) 
ActiveDocument.TablesOfContents.Add _ 
 Range:=myRange, _     '  <<<----need something like this
 UseFields:=False, _ 
 UseHeadingStyles:=True, _ 
 LowerHeadingLevel:=3, _ 
 UpperHeadingLevel:=1, _ 
 AddedStyles:="myStyle, yourStyle"

Your code does not have " Range:= rangeWord, " in the parameters.

You might open MS Word, press <alt>F11, open help from the IDE, search for "Range"......

[Homegrownandy]

Having some IT issues here preventing me from working on office. Seems to be okay right now.

this line:

Documents.Open Filename:=file

Is saying object required. The code originally used was full of errors which I've since realised. All I'm trying to do now is open the documents. Ill work on subroutine 2 once I have this working.

[Homegrownandy]

Thanks for the advice. I have this working now.

[orange]

Andy,

Can you tell us what you did and/or what was the issue? It may help others who browse or search the forum.

[Homegrownandy]

I stopped trying to get to the end and worked through the code. Its still not exactly what I want but it does work.

This puts the TOC on page one. when I want to set the range as page two. (ill work on that when I get the chance)

Sub openword()

 Dim FSO As Object
 Dim fPath As String
 Dim myFolder, myFile
 Dim wdApp As Object 'Late Binding
 Set FSO = CreateObject("Scripting.FileSystemObject")
 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
 .Show
 If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
 End With
 On Error Resume Next
 Set myFolder = FSO.GetFolder(fPath).Files
 If Err.Number <> 0 Then 'Cancel button clicked.
 Exit Sub
 End If
 For Each myFile In myFolder
 If LCase(myFile) Like "*.doc" _
 Or LCase(myFile) Like "*.docx" Or LCase(myFile) Like "*.docm" Then
 On Error Resume Next
 Set wdApp = GetObject(, "Word.Application")
 If Err.Number <> 0 Then 'Word not yet running
 Set wdApp = CreateObject("Word.Application")
 End If
 
 wdApp.Documents.Open CStr(myFile)
 Call secondSubRoutine
 wdApp.Visible = True
 Set wdApp = Nothing
 End If 'LCase
 Next myFile

End Sub
Sub secondSubRoutine()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
  Set oRng = ActiveDocument.Range
  oRng.Collapse
  
  With ActiveDocument
    .TablesOfContents.Add Range:=oRng, RightAlignPageNumbers:= _
      True, UseHeadingStyles:=False, IncludePageNumbers:=True, AddedStyles _
      :="SpecTOC,1", UseHyperlinks:=True, HidePageNumbersInWeb:=True, _
      UseOutlineLevels:=False
    .TablesOfContents(1).TabLeader = wdTabLeaderDots
    .TablesOfContents.Format = wdIndexIndent
  End With

End Sub