Microsoft Office Forums

Go Back   Microsoft Office Forums > >
Reload this Page Replace or apply new header in multiple files Replace or apply new header in multiple files
Register FAQ

Reply
 
Thread Tools Display Modes
  #1  
Old 04-29-2014, 03:14 PM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 32bit Replace or apply new header in multiple files Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,512
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
For what you describe, you could use a macro like the following. Simply add the macro to a document with your new header:
Code:
Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder
If strFolder = "" 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
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
            Next
            .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
As coded, the macro assumes the document you're running the macro from has only one Section, with up to three populated headers (as allowed by Word), and that all headers in the target document are to be updated to match the source document's primary header & footer. If you only want to update headers in the first Section, delete the footer loop and delete 'For Each Sctn In .Sections' and it's 'Next' later in the code and change 'For Each HdFt In Sctn.Headers' to 'For Each HdFt In .Sections(1).Headers'.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #2  
Old 04-30-2014, 09:03 AM
Carchee Carchee is offline Replace or apply new header in multiple files Windows 7 64bit Replace or apply new header in multiple files Office 2007
Advanced Beginner
Replace or apply new header in multiple files 		 
Join Date: Dec 2013
Posts: 46
Carchee is on a distinguished road
Default
The code does exactly what it needs to and works great.

Is there a way to create another function using the "CreateObject" or "GetObject" that selects the source file and sets the wdDocSrc to the chosen file rather than copying and pasting the code into the source file? I have been trying to do this all morning and haven't been successful.
Reply With Quote
  #3  
Old 04-30-2014, 03:04 PM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 32bit Replace or apply new header in multiple files Office 2010 32bit
Administrator
  
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,512
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default
Quote:
Originally Posted by Carchee View Post
Is there a way to create another function using the "CreateObject" or "GetObject" that selects the source file and sets the wdDocSrc to the chosen file rather than copying and pasting the code into the source file?
That's not how you'd go about it. Rather, you'd simply use another of the 'Documents.Open' procedures. For example, instead of:
Set wdDocSrc = ActiveDocument
use:
Set wdDocSrc = Documents.Open("C:\Users\" & Environ("Username") & "\Documents\source.docx", AddToRecentFiles:=False, Visible:=False)
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #4  
Old 03-08-2023, 12:11 PM
amanders0n amanders0n is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2016
Novice
  
Join Date: Mar 2023
Posts: 1
amanders0n is on a distinguished road
Default Help! Header Text not Updating
Quote:
Originally Posted by macropod View Post
For what you describe, you could use a macro like the following. Simply add the macro to a document with your new header:
Code:
Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder
If strFolder = "" 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
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
            Next
            .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
As coded, the macro assumes the document you're running the macro from has only one Section, with up to three populated headers (as allowed by Word), and that all headers in the target document are to be updated to match the source document's primary header & footer. If you only want to update headers in the first Section, delete the footer loop and delete 'For Each Sctn In .Sections' and it's 'Next' later in the code and change 'For Each HdFt In Sctn.Headers' to 'For Each HdFt In .Sections(1).Headers'.
--
Hello, I am trying to use the code quoted above. I will preface by saying I am a complete VBA noob and do not know much about VBA coding.

I have a header that has 3 columns. The first (leftmost) column is the one I want to update, and that header column has 3 rows that all need to be updated to the same thing across all files. I have one file that has this updated, and I copied the macro above into that document.

However, when I run the code, I get the following error: "Run-time error '5937': Cannot copy content between these two ranges."

Debugging tells me that this is the problematic code: .Range.FormattedText = _
wdDocSrc.Sections.First.Headers(HdFt.Index).Range. FormattedText

Help please...
Reply With Quote
  #5  
Old 07-10-2024, 08:47 AM
awhoughton awhoughton is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2021
Novice
  
Join Date: Jul 2024
Posts: 1
awhoughton is on a distinguished road
Default
Quote:
Originally Posted by macropod View Post
For what you describe, you could use a macro like the following. Simply add the macro to a document with your new header:
Code:
Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
strFolder = GetFolder
If strFolder = "" 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
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    With HdFt
                        If .Exists Then
                            If Sctn.Index = 1 Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
                                .Range.Characters.Last = vbNullString
                            End If
                        End If
                    End With
                Next
            Next
            .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
As coded, the macro assumes the document you're running the macro from has only one Section, with up to three populated headers (as allowed by Word), and that all headers in the target document are to be updated to match the source document's primary header & footer. If you only want to update headers in the first Section, delete the footer loop and delete 'For Each Sctn In .Sections' and it's 'Next' later in the code and change 'For Each HdFt In Sctn.Headers' to 'For Each HdFt In .Sections(1).Headers'.

What needs to change if I want all the .doc AND .docx files in a folder to be updated?
Reply With Quote
Reply

Tags
macropod

« Previous Thread | Next Thread »


Similar Threads
Thread Thread Starter Forum Replies Last Post
Replace or apply new header in multiple files Find & Replace in Header/Footer in 1000 files amodiammmuneerk@glenmarkp Word 12 03-05-2018 03:31 AM
Replace or apply new header in multiple files Find & Replace in Header/Footer PReinie Word 6 01-22-2014 06:45 PM
Replace or apply new header in multiple files How to apply a list style to multiple Word documents? MrSnrub Word 4 06-19-2013 07:32 AM
Replace or apply new header in multiple files Apply template to multiple documents Oliver Beirne Word VBA 2 04-24-2012 04:49 AM
Replace or apply new header in multiple files convert multiple csv files to multiple excel files mit Excel 1 06-14-2011 10:15 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 10:08 AM.

Contact Us - Privacy Statement - Top

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft