Multi-File Header Change

[cspande]

I have zero experience in Word VBA. I am looking for a way to change the header in one document and update multiple documents in a specified folder.



We have specification documents that need to have their headers updated quite regularly. I'd like to be able to use a Word document as the template where any changes that need to take place will occur in the document. I would then like to use that document to change multiple documents automatically. These other documents would be located in a folder. Ideally, the process flow would be like this:

Open "template.docx"
Open Header/add date "March 1, 2018"
Close Header
Save document
Run macro - select folder location of all documents that need the header changed.

Currently we copy/paste the updated header into each document separately which involves opening document/open header/paste/close header/save/close document repeat 100+ times. This process takes place for one project, extrapolate to the 100s of projects my company produces...you get the picture.

I've stumbled upon this thread and code but have not been able to understand it:
https://www.msofficeforums.com/word-...html#post62942

It appears as if this code should work but I must be missing something as to I don't understand how to make it grab the folder location and institute the changes made to my template document.

Version: Word 2013

Thank you for your time,

[macropod]

Try:

Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, StrTxt As String
Dim wdDocTgt As Document, wdDocSrc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
StrTxt = InputBox("Text to add to headers? e.g. ""March 1, 2018""")
If Trim(StrTxt) = "" Then Exit Sub
Set wdDocSrc = ActiveDocument
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
    If strFolder & "\" & strFile <> wdDocSrc.FullName Then
        Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _
        AddToRecentFiles:=False, Visible:=False)
        With wdDocTgt
            .Sections(1).Headers(wdHeaderFooterPrimary).Range.InsertAfter StrTxt
            .Close SaveChanges:=True
        End With
    End If
    strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[cspande]

Macropod,

Thanks! That macro works great. I'm curious though, (1.)how can I manipulate it to include more than one line of text and various spacing? (2.)Or is it possible for me to create a custom header in a document(headertemplate.docx) that can be referenced when the script runs and implement it into the documents in the selected folder?

(1.) For example, my header looks like this:

 
Project Location                                              Date
Project Name                                           Drawing Set
Contract Number                                      Issuance Date

When I run the script, inputting March 1, 2018 it appears as this:

 
Project Location                                              Date
Project Name                                           Drawing Set
Contract Number                                      Issuance Date
March 1, 2018

Often times I need to change the Issuance Date and Drawing Set throughout the duration of the project. Other times I need to only change the Issuance Date. This would be were (2.) could come in handy. If I can make adjustments in one file then extrapolate it to all the files in my selected folder, I could make whatever changes needed instead of piece-mealing certain parts and then having to deal with formatting, style, font etc.

I'll do some research into other scripts on how to read a "template" file and try to put something together.

Thank you for spending the time helping me!
cspande

[macropod]

I'd have thought you'd want either 'Date' or 'Issuance Date' replaced with your actual date (e.g. March 1, 2018), or your actual date insert after 'Date' or 'Issuance Date', not simply to have your actual date inserted after what's already in you header. What you're getting, though, is what you specified.

Any of the individual items in the header can be replaced or appended to, or even the whole header can be overwritten. You need to be clear about what your requirements are.

[cspande]

I see that I have been unclear. Ideally, the whole header would be re-written.

For example: Template

Building Name, Complex Name                                         Original Start Date
Project Name                                                                Drawing Set
Company Contract Information                                              Issuance Date

Template Changes:

Warehouse ABC - Industrial Complex 1                                  20 December 2017
Rooftop AHU Retrofit                                                           Bid Set
Company B Contract No. 1234-456-89                           Reissued 13 February 2018

We would be able to change the header in the template document and then using the getFolder code, the macro would change all the documents in the folder to reflect the template's header.

[macropod]

In that case, if you run the macro from a document containing the required header, you could simply delete:

StrTxt = InputBox("Text to add to headers? e.g. ""March 1, 2018""")
If Trim(StrTxt) = "" Then Exit Sub

and change:
.Sections(1).Headers(wdHeaderFooterPrimary).Range. InsertAfter StrTxt
to:

            With .Sections(1).Headers(wdHeaderFooterPrimary).Range
              .FormattedText = wdDocSrc.Sections(1).Headers(wdHeaderFooterPrimary).Range.FormattedText
              .Characters.Last.Delete
            End With

[cspande]

That works flawlessly. We removed the pop up that asks what to add to the header. Thanks for your time and effort. I could not have even begun to develop it on my own, but I am enjoying the process.