Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 05-07-2014, 08:43 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 originally received the error with the code in post #11 so I was trying different options and forgot to delete that code before posting. I looked at the references as per post #17 and the only reference is "Reference to Normal"

If all else fails I can always go back to the original code that worked without formatting. It will still save an enormous amount of time. Thanks for your help on this Paul.
Reply With Quote
  #17  
Old 05-07-2014, 02:27 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

Perhaps then you should post the code you're actually using that's failing. The code you posted certainly won't work.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #18  
Old 05-07-2014, 03:27 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

Note that I haven't updated the footer code to match the header. The same error shows up for each case I select in the userform. If I isolate the footer code it works but if I isolate the header code it gives me the same error. Here is the whole thing:


Code:
Option Explicit
 
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
 
'**********************************************************************************************
 
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
 
'******************************************************************************************
 
Case "Replace footer"
 
   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
    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.Footers
                    With HdFt
                        If .LinkToPrevious = False Then
                            .Range.FormattedText = _
                            wdDocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText
                        End If
                    End With
                Next
            Next
            .Close SaveChanges:=True
        End With
                strFile = Dir()
    Wend
    Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
    Application.ScreenUpdating = True
 
'***************************************************************************************
 
Case "Edit text within footer"
 
strFnd = InputBox("Text to Replace", "Old String")
If strFnd = "" Then Exit Sub
strRep = InputBox("Replacement Text", "New String")
If strRep = "" Then Exit Sub
 
wdStory = Array(wdPrimaryFooterStory, wdFirstPageFooterStory, wdEvenPagesFooterStory)
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
 
End Select
 
 
 
End Sub
Private Sub UserForm_Initialize()
 
    cboHFList.AddItem "Replace header"
    cboHFList.AddItem "Edit text within header"
    cboHFList.AddItem "Replace footer"
    cboHFList.AddItem "Edit text within footer"
 
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
  #19  
Old 05-07-2014, 04:05 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

You have NOT made the change as advised in post #11! You should not still have:
.Range.FormattedText = _
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #20  
Old 05-08-2014, 08:07 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 can't believe I overlooked that! And to think we could have been done at post #11. It works perfectly. Thanks Paul for your patience and help. This macro does everything I need it too, thanks again.
Reply With Quote
  #21  
Old 05-10-2016, 10:33 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

Macropod, I need your help!

Long time since I've been on here. Any idea why this same Macro won't work in Word 2010 and 2013? I've tried researching the differences between the code for 2007 vs later versions but can't find anything. Thanks
Reply With Quote
  #22  
Old 05-10-2016, 01:16 PM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 64bit 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 no reason for the code to not work in Word 2010 or 2013. Indeed, at my end it was developed & tested on Word 2010.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #23  
Old 05-12-2016, 11:55 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

Everything but the replace header works. It copies the first line of the document instead, as seen in the pic.
Reply With Quote
  #24  
Old 05-12-2016, 02:10 PM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 64bit 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

That looks to me rather like the header you're copying has a STYLEREF field that's picking up the Style used by the heading that's being replicated. Try pressing Alt-F9 in the affected document - you may then seen a field coded like { STYELREF MyStyle } in the header.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #25  
Old 06-24-2016, 02:53 PM
Carchee Carchee is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2013
Advanced Beginner
Replace or apply new header in multiple files
 
Join Date: Dec 2013
Posts: 46
Carchee is on a distinguished road
Default

Paul,

It's been a busy few months. I did as you told me, pressed Alt-F9 and no STYLEREF's are present. Just to make sure I created one in the header and keyed Alt-F9 and the STYLEREF showed up. So we can eliminate that one.

I am using Windows 10 but I don't think that could be the culprit either.
Reply With Quote
  #26  
Old 06-24-2016, 04:40 PM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 64bit 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

Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #27  
Old 06-28-2016, 01:46 PM
Carchee Carchee is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2013
Advanced Beginner
Replace or apply new header in multiple files
 
Join Date: Dec 2013
Posts: 46
Carchee is on a distinguished road
Default

Paul,

I experimented a little with these two files I have attached. Two scenarios with two different results:
  1. When I use the Test.doc file as the source "Replace Header" file it works
  2. When I use the Test2.doc file as the source "Replace Header" file it doesn't work as shown in the pic from post #26.
Which leaves me to conclude that the code is working but for some reason it's not working with this one file......frustrating
Attached Files
File Type: doc Test.doc (32.0 KB, 18 views)
File Type: doc Test2.doc (29.5 KB, 12 views)
Reply With Quote
  #28  
Old 06-29-2016, 10:42 AM
macropod's Avatar
macropod macropod is offline Replace or apply new header in multiple files Windows 7 64bit 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

Your documents have different page layouts - Test1 has a std page layout but Test2 has a 'different first page' setup'. The macro is not coded for the latter, as it references only:
wdHeaderFooterPrimary
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #29  
Old 05-30-2017, 08:44 AM
msir msir is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2013
Novice
 
Join Date: May 2017
Posts: 1
msir is on a distinguished road
Default

Carchee,

Is there any way you can post your code file? I am looking to do the exact same thing as you but could not get it working with the codes that were posted.

Thanks in advance!
Reply With Quote
  #30  
Old 02-17-2022, 12:22 PM
Afrederick Afrederick is offline Replace or apply new header in multiple files Windows 10 Replace or apply new header in multiple files Office 2019
Novice
 
Join Date: Feb 2022
Posts: 1
Afrederick is on a distinguished road
Default Re: macropod

Hello macropod,


Your script here works nearly perfectly for something I am trying to achieve, and I was hoping you could give me a tip on an issue I am facing.


I have a source document with headers and footers that I want to push to a whole folder of word documents. The issue is that in some of the word documents that are receiving the new headers/footers have a table in the footer. For example some have a 1 row, 2 column table in the footer to show the page title and project number respectively. When I run the script you wrote (which works exactly how it is written) it doesnt remove the table and replace it with the source footer. Instead it just removes all the text and replaces it with the source text. This causes extra spacing and formatting issues since is extra spacing with the tables.


If you have any tips I would greatly appreciate it. Thank you!
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 08:11 AM.


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