previously in the article below I’ve explained how you can modify multiple word files:

• Word VBA, Apply Macro to Multiple Files

In this article I will explain how you can extend that concept to modify the header of multiple word files using VBA.

Header and VBA:

Doesn’t matter what you are trying to do with your documents header:

• Modify
• Create
• Delete

You can get the code using the macro recorder.

The code below was generated by the macro recorder when  creating a header in word manually:

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or _
    ActiveWindow.ActivePane.View.Type = wdOutlineView _
Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Application.Templates( _
    "C:UsersPedrumAppDataRoamingMicrosoftDocument " & _
        "Building Blocks103314Built-In Building Blocks.dotx" _
    ).BuildingBlockEntries(" Blank").Insert _
    Where:=Selection.Range, RichText:=True
Selection.TypeText Text:="My New Header "
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


The macro recorder will not always record exactly what we are looking for therefore some changes might be required.

1. The first change would be to replace the highlighted text with the text you would like to appear in the header area.
2. The second would be adding the 2 lines below. They will remove any previous header text:

Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1


So for example by using the code below the header will be replaced with the text “Another header”:

'code generated by the macro recorder
Sub main()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or _
    ActiveWindow.ActivePane.View.Type = wdOutlineView _
Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Application.Templates( _
    "C:UsersPedrumAppDataRoamingMicrosoftDocument " & _
    "Building Blocks103314Built-In Building Blocks.dotx" _
    ).BuildingBlockEntries(" Blank").Insert _
    Where:=Selection.Range, RichText:=True
   
'added these two line
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Another Header"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub


Result:

Modify Header for Single File:

As explained at the start of the article, the article below explains how you can modify all the word documents in a folder using VBA:

• Word VBA, Apply Macro to Multiple Files

In that article there was a function called ModifyFile:

Private Sub ModifyFile(ByVal strPath As String)


This function would receive as input the path of the word file and apply modification to the file. All we have to do is replace the code in that function with the code generated by the macro recorder in this article. The code below opens the word file located at the path “D:StuffBusinessTemp1.docx”, changes the header text to “Another Header” and closes the file.

'code generated by the macro recorder
Sub main()
Call ModifyFile("D:StuffBusinessTemp1.docx")
End Sub 

Private Sub ModifyFile(ByVal strPath As String)
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate

'code generated by macro recorder
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or _
    ActiveWindow.ActivePane.View.Type = wdOutlineView _
Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Application.Templates( _
    "C:UsersPedrumAppDataRoamingMicrosoftDocument " & _
    "Building Blocks103314Built-In Building Blocks.dotx" _
    ).BuildingBlockEntries(" Blank").Insert _
    Where:=Selection.Range, RichText:=True
     
'added these two line
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Another Header"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

'close the file
objDocument.Close (True)
End Sub


Complete Code:

The code  below does the following things:

1. Displays a folder dialog
2. If the user selects a folder, the path of all the files in that folder is retrieved
3. The header of each of those files are modified

Sub Example()
Dim intResult As Integer
Dim strPath As String
Dim arrFiles() As String
Dim i As Integer
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
    'dispaly message box
    strPath = Application.FileDialog( _
        msoFileDialogFolderPicker).SelectedItems(1)
    arrFiles() = GetAllFilePaths(strPath)
    For i = LBound(arrFiles) To UBound(arrFiles)
        Call ModifyFile(arrFiles(i))
    Next i
End If
End Sub


Private Sub ModifyFile(ByVal strPath As String)
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate

'code generated by macro recorder
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or _
    ActiveWindow.ActivePane.View.Type = wdOutlineView _
Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Application.Templates( _
    "C:UsersPedrumAppDataRoamingMicrosoftDocument " & _
    "Building Blocks103314Built-In Building Blocks.dotx" _
    ).BuildingBlockEntries(" Blank").Insert _
    Where:=Selection.Range, RichText:=True
   
'added these two line
Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Another Header"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'close the file
objDocument.Close (True)
End Sub 

Private Function GetAllFilePaths(ByVal strPath As String) _
As String()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim arrOutput() As String
ReDim arrOutput(1 To 1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strPath)
i = 1
'loops through each file in the directory
'and prints their names and path
For Each objFile In objFolder.Files
    ReDim Preserve arrOutput(1 To i)
    'print file path
    arrOutput(i) = objFile.Path
    i = i + 1
Next objFile
GetAllFilePaths = arrOutput
End Function


You can download the file and code related to this article from the link below:

• Modify Header for Multiple Files.docm

See also:

• Word VBA, Open Document
• Word Automation VBA, Common Errors
• Word VBA, Apply Macro to Multiple Files
• Word Automation VBA, Common Errors
• VBA, Write Excel Values to Word Document
• VBA, Automating Word From Excel

If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website  www.software-solutions-online.com