Consulting

Results 1 to 4 of 4

Thread: Analysing a Word Documents headings and write it in an array

  1. #1
    VBAX Newbie
    Joined
    Jul 2014
    Posts
    3
    Location

    Post Analysing a Word Documents headings and write it in an array

    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!

  2. #2
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,774
    We can help you even better if you post a sample Word document.

  3. #3
    VBAX Newbie
    Joined
    Jul 2014
    Posts
    3
    Location
    Quote Originally Posted by snb View Post
    We can help you even better if you post a sample Word document.
    Attached Files Attached Files

  4. #4
    Knowledge Base Approver VBAX Guru
    Joined
    Apr 2012
    Posts
    4,774
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •