Search code examples
vbaheaderms-wordword-2016

How to return the value of the first header found above a paragraph in word using vba?


I'm currently writing a vba macro for word which is supposed to grab all comments in the document and return them in a newly created excel file. I'm almost done but I run into a problem with the paragraph indication. I want to put the paragraphs corresponding header in the excel as well. In order to do this I would have to either get the paragraph header directly or find the first header-related format above the paragraph. At least those are the options I could think of. Any idea how best to tackle this problem?

Sub exportComments()

Dim xlApp As Object
Dim xlWB As Object
Dim i As Integer, HeadingRow As Integer
Dim objPara As Paragraph
Dim objComment As Comment
Dim strSection As String
Dim strTemp
Dim myRange As Range
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add 'create a new workbook
With xlWB.Worksheets(1)
' Create Heading
    HeadingRow = 1
    .Cells(HeadingRow, 1).Formula = "Comment"
    .Cells(HeadingRow, 2).Formula = "Page"
    .Cells(HeadingRow, 3).Formula = "Paragraph"
    .Cells(HeadingRow, 4).Formula = "Commented part"
    .Cells(HeadingRow, 5).Formula = "Comment"
    .Cells(HeadingRow, 6).Formula = "Reviewer"
    .Cells(HeadingRow, 7).Formula = "Date"
    strSection = "preamble" 'all sections before "1." will be labeled as "preamble"
    strTemp = "preamble"
    If ActiveDocument.Comments.Count = 0 Then
        MsgBox ("No comments")
        Exit Sub
    End If
    For i = 1 To ActiveDocument.Comments.Count
        Set myRange = ActiveDocument.Comments(i).Scope
        strSection = ParentLevel(myRange.Paragraphs(1))
        'MsgBox strSection
        'Comment line
        .Cells(i + HeadingRow, 1).Formula = ActiveDocument.Comments(i).Index
        'Page number line
        .Cells(i + HeadingRow, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
        'Paragraph indicator line
        .Cells(i + HeadingRow, 3).Formula = ActiveDocument.Comments(i).Scope.Paragraphs(1)
        'Commented part line
        .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Scope.FormattedText
        'Comment value line
        .Cells(i + HeadingRow, 5).Formula = ActiveDocument.Comments(i).Range
        'Comment reviewer line
        .Cells(i + HeadingRow, 6).Formula = ActiveDocument.Comments(i).Author
        'Comment date line
        .Cells(i + HeadingRow, 7).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")
    Next i
End With
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

Function ParentLevel(Para As Word.Paragraph) As String
    ' Finds the first paragraph of the current section
    Dim oSection As Section
    Dim iSection As Integer
    Dim lngPara As Long
    Dim oRng As Range, oPara As Range
        iSection = Para.Range.Information(wdActiveEndSectionNumber)
        Set oSection = ActiveDocument.Sections(iSection)
        Set oRng = oSection.Range
        For lngPara = 1 To oRng.Paragraphs.Count
            Set oPara = oRng.Paragraphs(lngPara).Range
            If Len(oPara) > 1 Then
                Exit For
            End If
        Next lngPara
        oPara.End = oPara.End - 1
        ParentLevel = oPara.Text
    End Function

So the idea is to put the paragraph header at Headingrow 3. The solution would have to adjust to different header formats as the documents I work with often have selfmade header formats. The only thing I can rely on is the headers having the word header in the style name. Any help would be appreciated and ofcourse I can add more information might any be missing.


Solution

  • You're on the right track and seem fairly capable of writing VBA so this answer is more advisory than definitive.

    Identifying "Header" in the style name could be an option, but only if you can rely on the Styles to be correctly named to fit this. In scenarios where variables are volatile (likely to change unpredictably), there's a solution that often doesn't take too much development: Prompt the user to provide this information when running the macro!

    In your case you mention that headers often have custom formats, you could grab the used formats and prompt the user with a UserForm to identify which of these formats are used for the paragraph headers. By using Styles in the documents, these are more easily accessed in VBA:

    Sub getStyles()
        Dim UsedStyles As New Collection
        Dim pgf As Paragraph
    
        For Each pgf In ActiveDocument.Paragraphs
            UsedStyles.Add pgf.Style.NameLocal
        Next pgf
    End Sub
    

    This will loop through all the paragraphs in the document, and create a unique list (Collection) containing the names of all the styles used within the document. You can then pass this to a UserForm with a MultiSelect ListBox, instructing the user to select which styles are used for headers. Return the users selection back to your macro and use this as your comparison to seek out the headers.