Creating headers in Word with VBA

Question

I'm having trouble with adding a header only to the first page of a Word document. Here is the code; the header appears on every page from a second page in the Word document. How can I change it so the header would only be on the first page of a Word document?

Here is the code:

Sub CreateWordFileFromExcel()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim filePath As String

    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True

    Set wordDoc = wordApp.Documents.Add

    desktopPath = Environ("USERPROFILE") & "\Desktop\"

    filePath = desktopPath & "TemplateMEMO.docx" ' Replace this with your desired file path and name"

    ThisWorkbook.Sheets("1").UsedRange.Copy

    Dim headerRange As Object
    Set headerRange = wordDoc.Sections(1).Headers(1).Range
    headerRange.Text = "Company name" & vbCr & _
                       "Address" & vbCr & _
                       "City" & vbCr & _
                       "Country" & vbCr & _
                       "Tel: +7 (727) 777 77 77" & vbCr & _
                       "Fax: +7 (727) 888 88 88" & vbCr & _
                       "company website"

    headerRange.ParagraphFormat.Alignment = 2
    headerRange.Font.Size = 9

    wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True
    Dim section As Object
    For Each section In wordDoc.Sections
        If section.Index > 1 Then
            section.Headers(1).Range.Text = ""
        End If
    Next section

    wordApp.Selection.Collapse Direction:=0 ' 0 for collapse to the end of the range

    ThisWorkbook.Sheets("2").UsedRange.Columns.AutoFit

    wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

    wordDoc.SaveAs filePath

    Set wordDoc = Nothing
    Set wordApp = Nothing
    Set headerRange = Nothing
    Set logoShape = Nothing
End Sub

I already tried this:

wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True
Dim section As Object
For Each section In wordDoc.Sections
    If section.Index > 1 Then
        section.Headers(1).Range.Text = ""
    End If
Next section

And this:

wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True

Dim section As Object
For Each section In wordDoc.Sections
    If section.Index > 1 Then
        section.Headers(1).Range.Delete
    End If
Next section

and this:

wordApp.Selection.InsertBreak Type:=7 ' (since I have 7 pages)
Dim section As Object
For Each section In wordDoc.Sections
    If section.Index > 1 Then
        section.Headers(1).Range.Delete
    End If
Next section

score 0 · Answer 1 · answered Jul 31 '23 at 08:52

Replace this

    Dim headerRange As Object
    Set headerRange = wordDoc.Sections(1).Headers(1).Range
    headerRange.Text = "Company name" & vbCr & _
                      "Address" & vbCr & _
                      "City" & vbCr & _
                      "Country" & vbCr & _
                      "Tel: +7 (727) 777 77 77" & vbCr & _
                      "Fax: +7 (727) 888 88 88" & vbCr & _
                      "company website"
                                 
             headerRange.ParagraphFormat.Alignment = 2
       headerRange.Font.Size = 9
   

       wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True
      Dim section As Object
      For Each section In wordDoc.Sections
        If section.Index > 1 Then
            section.Headers(1).Range.Text = ""
        End If
    Next section

with this

    Dim headerRange As Object
    Set headerRange = wordDoc.Sections(1).Headers(2).Range
    wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True
    headerRange.Text = "Company name" & vbCr & _
            "Address" & vbCr & _
            "City" & vbCr & _
            "Country" & vbCr & _
            "Tel: +7 (727) 777 77 77" & vbCr & _
            "Fax: +7 (727) 888 88 88" & vbCr & _
            "company website"
                                     
    headerRange.ParagraphFormat.Alignment = 2
    headerRange.Font.Size = 9

The material changes here are:

Changed header type from 1 (which is wdHeaderFooterPrimary) to 2 (which is wdHeaderFooterFirstPage)
Having done that, there is no need to loop over each subsequent Section and try to set the header text to an empty string

It should be clear from point 1 why this code works and yours does'nt do what you want (noting that the 'primary' header is applied to all pages of the section if no other header types exist).

You might also want to read up about early vs late binding (there are loads of other SO questions on this) ... if you were using early binding then you could use wdHeaderFooterPrimary or wdHeaderFooterFirstPage directly (which would have helped you debug your code) instead of having to use values 1 or 2.

Creating headers in Word with VBA

1 Answers1