Analysing a Word Documents headings and write it in an array

[nappi90]

Hey i wanna analyse a documents headings and put them into a 3-dimensional array.
So that i always know which heading belongs to which chapter... Can you help me?

e.g.:

1 Hello
1.1 Helloo
1.2 Helloo2
1.1.1 Hellooo
2 Bye
2.1 Byee
2.1.1 Byeee

array:
1 2 3
1 Hello Helloo Hellooo
Helloo2
2 Bye Byee Byeee



my code is not working yet. Headinglevel 1 is working... but the rest is not... and i dont know why!


Sub testoe()
Dim WordApp As Object
Dim Rng As Word.Range
Dim Rng1 As Word.Range
Dim Rng2 As Word.Range
Dim kapNr1 As Integer
Dim kapNr2 As Integer
Dim kapNr3 As Integer


Dim kapitel(40, 150, 150) As String
kapNr1 = 1
kapNr2 = 1
kapNr3 = 1
Set WordApp = CreateObject("Word.Application")

With WordApp
.Documents.Open ("Test.doc")
.Visible = True
End With

Set Rng = WordApp.ActiveDocument.Content
Rng.Find.Style = wdStyleHeading1
Rng.Find.Execute
Do While Rng.Find.Found = True
Rng.Find.Style = wdStyleHeading1
Rng.Select
WordApp.Selection.Copy
kapitel(kapNr1, 0, 0) = clipboard2String
kapNr1 = kapNr1 + 1

Set Rng1 = Rng.Duplicate
Rng1.Find.Style = wdStyleHeading2
Rng1.Find.Execute
Do While Rng1.Find.Found = True
Rng1.Find.ClearFormatting
Rng1.Find.Style = wdStyleHeading2
Rng1.Select
WordApp.Selection.Copy
kapitel(kapNr1, kapNr2, 0) = clipboard2String
kapNr2 = kapNr2 + 1

Set Rng2 = Rng1.Duplicate
With Rng2.Find
.Style = wdStyleHeading3
.Execute
Do While .Found = True
.Style = wdStyleHeading3
Rng2.Select
WordApp.Selection.Copy
kapitel(kapNr1, kapNr2, kapNr3) = clipboard2String
kapNr3 = kapNr3 + 1
.Execute Forward:=True

Loop
End With
kapNr3 = 1
Rng1.Find.Execute Forward:=True
Loop
kapNr2 = 1

Rng.Find.Execute Forward:=True
Loop


'WordApp.ActiveDocument.Saved = False
WordApp.Application.Quit


MsgBox kapitel(1, 1, 0), vbInformation, "Hinweis"

End Sub

Hope you can help me! Thanks!

[snb]

We can help you even better if you post a sample Word document.

[nappi90]

We can help you even better if you post a sample Word document.

[snb]

Did you consider inserting a table of contents in the document ?


Sub M_snb()
Application.Templates("C:\Documents and Settings\***\Application Data\Microsoft\Document Building Blocks\1033\14\Built-In Building Blocks.dotx").BuildingBlockEntries("Automatic Table 2").Insert Selection.Range, True
End Sub