Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-29-2014, 12:40 PM
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 Replace or apply new header in multiple files

Our company has specification with our own headers and footers, however from time to time we are required to use a header and footer not of our own. It becomes tedious to open each file and delete the header and replace it with the new one. I can't simply do a find and replace because the format of the header is always completely different.



Any ideas on how to change headers in multiple files? I received code a while back from macropod which would find and replace text within headers with multiple files which works great. I was thinking it would be similar but not sure how to alter the code. Also how do I keep the original formatting such as text size and font from the source?

I have set it up with the use of forms.
The following code is what I received from macropod, but it has been altered for my application.

Code:
Private Sub cbOptionOK_Click()

Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim strFnd As String, strRep As String, wdStory(), i As Long

'Cue function to select folder where files are found

strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)

Select Case cboHFList.Value

Case "Replace Header"



'******************************************************

Case "Edit text within header"

'Input text
strFnd = InputBox("Text to Replace", "Old String", "Water Feature Facility")
If strFnd = "" Then Exit Sub
strRep = InputBox("Replacement Text", "New String")
If strRep = "" Then Exit Sub

wdStory = Array(wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    On Error Resume Next
    For i = LBound(wdStory) To UBound(wdStory)
      'MsgBox wdStory(i)
      With .StoryRanges(wdStory(i)).Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strFnd
        .Replacement.Text = strRep
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
    Next
    On Error GoTo 0
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True


Private Sub UserForm_Initialize()

    cboHFList.AddItem "Replace header"
    cboHFList.AddItem "Edit text within header"


End Sub

'Function to select folder where files are found

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
Reply With Quote
  #2  
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: 21,956
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
  #3  
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
  #4  
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: 21,956
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
  #5  
Old 04-30-2014, 03:42 PM
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

Okay I see how that would work if the source file was always in that specific spot, however the source file will be in different folders each time. So it would be nice if the user could pick where the source file is located just like the user picked where the folder containing the target files are.
Reply With Quote
  #6  
Old 04-30-2014, 04:02 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: 21,956
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

In that case, you could use:
Code:
    With Application.Dialogs(wdDialogFileOpen)
      If .Show = -1 Then
        Set wdDocSrc = ActiveDocument
      Else
        MsgBox "No Source document chosen. Exiting", vbExclamation
        Exit Sub
      End If
    End With
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 05-01-2014, 07:56 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

Works great! Thanks for the help.
Reply With Quote
  #8  
Old 05-01-2014, 08:57 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

Now getting more complex now, at least for me, okay lets be honest all this is complex for me but I'm learning.

The source header is single spaced and has 0 pt before and after lines, however after the the source header is pasted the line spacing is changed to 10 pt after lines. I noticed it does this if I manually copy and paste.
Reply With Quote
  #9  
Old 05-01-2014, 02:42 PM
Charles Kenyon Charles Kenyon is offline Replace or apply new header in multiple files Windows 7 64bit Replace or apply new header in multiple files Office 2010 32bit
Moderator
 
Join Date: Mar 2012
Location: Sun Prairie, Wisconsin
Posts: 9,082
Charles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant future
Default

One completely different method is to store the headers and footers in a template as AutoText and use AutoText fields to incorporate them.

To change them wholesale, simply load a different Add-In template containing the AutoText you want.

This would require revamping everything, but if you do this often you might want to consider it.

I am a stringer for a national law firm and when I do work for them, I simply change my loaded AutoText holder and all of my forms change to show that firm's information. It is work to set up, but a piece of cake to make the switch when needed.

I also did this when I worked for a lawfirm with more than 50 local offices that needed local information in their (otherwise uniform) letterhead and forms. In that case, it was bits and pieces of the headers rather than the whole header.

P.S. If you use this method, document it VERY WELL or you will make some people very upset when you are not around.
Reply With Quote
  #10  
Old 05-01-2014, 02:44 PM
Charles Kenyon Charles Kenyon is offline Replace or apply new header in multiple files Windows 7 64bit Replace or apply new header in multiple files Office 2010 32bit
Moderator
 
Join Date: Mar 2012
Location: Sun Prairie, Wisconsin
Posts: 9,082
Charles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant futureCharles Kenyon has a brilliant future
Default

Quote:
Originally Posted by Carchee View Post
Now getting more complex now, at least for me, okay lets be honest all this is complex for me but I'm learning.

The source header is single spaced and has 0 pt before and after lines, however after the the source header is pasted the line spacing is changed to 10 pt after lines. I noticed it does this if I manually copy and paste.
You would need to be transferring in the Style as well. The default is to use the existing Style in the receiving document/template.
Reply With Quote
  #11  
Old 05-01-2014, 02:55 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: 21,956
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
The source header is single spaced and has 0 pt before and after lines, however after the the source header is pasted the line spacing is changed to 10 pt after lines. I noticed it does this if I manually copy and paste.
Evidently, then, someone is overriding the Style definitions, with manual formatting. If the Styles were being used properly, that wouldn't be an issue. You could try replacing:
Code:
.Range.FormattedText = _
wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
with:
Code:
wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Copy
.Range.PasteAndFormat wdFormatOriginalFormatting
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #12  
Old 05-05-2014, 12:39 PM
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 .Copy gives a compile error. Also instead of simply copying your code I wrote it from scratch to get the pop ups and selected the appropriate ones and it still gives me the code.
Reply With Quote
  #13  
Old 05-05-2014, 03:47 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: 21,956
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

I am unable to reproduce that error. You can demonstrate that there's nothing wrong with that line by running the following macro in a scratch document:
Code:
Sub Test()
Dim wdDocTgt As Document, wdDocSrc As Document
Set wdDocSrc = ActiveDocument
wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.Copy
wdDocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.PasteAndFormat wdFormatOriginalFormatting
End Sub
This code simply copies the header content to the footer in the same document. What particular error message are you getting?
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #14  
Old 05-06-2014, 08:25 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

I get a Compile error: Expected Function or variable

It highlights the .Copy in blue. The help says I am trying to inappropriately assign a value to a procedure name.

The following is my code. I have it set up with userforms and Case's so you won't be able to run it but at least you can see it as a whole. I see no reason why this code shouldn't work.

Code:
Private Sub cbOptionOK_Click()
 
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim strFnd As String, strRep As String, wdStory(), i As Long
Dim wdDocTgt As Document, wdDocSrc As Document
Dim Sctn As Section, HdFt As HeaderFooter
 
'Cue function to select folder where specification files are found
 
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
 
Unload Me
 
Select Case cboHFList.Value
 
Case "Replace header"
 
      With Application.Dialogs(wdDialogFileOpen) 'Open header source file
      If .Show = -1 Then
        Set wdDocSrc = ActiveDocument
      Else
        MsgBox "No Source document chosen. Exiting", vbExclamation
        Exit Sub
      End If
    End With
    strFile = Dir(strFolder & "\*.doc", vbNormal)
    While strFile <> ""
        Set wdDocTgt = Documents.Open(FileName:=strFolder & "\" & strFile, _
        AddToRecentFiles:=False, Visible:=False)
        With wdDocTgt
            For Each Sctn In .Sections
                For Each HdFt In Sctn.Headers
                    With HdFt
                        If .Exists Then
                            If .LinkToPrevious = False Then
                                .Range.FormattedText = _
                                wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.Copy
                                wdDocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.PasteAndFormat wdFormatOriginalFormatting
                            End If
                        End If
                    End With
                Next
            Next
            .Close SaveChanges:=True
        End With
                strFile = Dir()
    Wend
    Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
    Application.ScreenUpdating = True
Reply With Quote
  #15  
Old 05-06-2014, 04:32 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: 21,956
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

There is a perfectly good reason it wouldn't work. You're using something quite different from what I advised in post #11: https://www.msofficeforums.com/word-...html#post63089
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Tags
macropod

Thread Tools
Display Modes


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 12:06 PM.


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