Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-25-2022, 01:20 PM
PolarPop PolarPop is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2021
Novice
Replace lines of text from header in multiple files
 
Join Date: May 2022
Posts: 4
PolarPop is on a distinguished road
Default Replace lines of text from header in multiple files

I've recently been tasked to update the header of over 500 word files. I originally used a macro provided from macropod to replace the header in each file with one from a separate file. That worked smoothly. But when comparing the files, it was discovered that many of them had other information in the header that wasn't supposed to be removed.

It was determined that only the first 3 lines of text in the header needs to be replaced. Each line of text is slightly different so a bulk "find and replace" won't work. Also the 3 lines in every document contain 52 characters, so I think I can use that. I'm thinking that the code can be modified to do what I need it to do, but I have no clue where to start.



Code:
Sub ReplaceDocumentHeaders()
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
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Copy
                                .Range.PasteAndFormat wdFormatOriginalFormatting
                                .Range.Characters.Last = vbNullString
                            ElseIf .LinkToPrevious = False Then
                                wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Copy
                                .Range.PasteAndFormat wdFormatOriginalFormatting
                                .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
Reply With Quote
  #2  
Old 05-25-2022, 04:45 PM
macropod's Avatar
macropod macropod is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2016
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

Try something along the lines of:
Code:
Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
Dim wdRngSrc As Range, wdRngTgt As Range
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
                                Set wdRngTgt = .Range.Characters.First
                                wdRngTgt.End = wdRngTgt.End + 51
                                Set wdRngSrc = wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Characters.First
                                wdRngSrc.End = wdRngSrc.End + 51
                                wdRngTgt.FormattedText = wdRngSrc.FormattedText
                            ElseIf .LinkToPrevious = False Then
                                Set wdRngTgt = .Range.Characters.First
                                wdRngTgt.End = wdRngTgt.End + 51
                                Set wdRngSrc = wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Characters.First
                                wdRngSrc.End = wdRngSrc.End + 51
                                wdRngTgt.FormattedText = wdRngSrc.FormattedText
                            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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 05-25-2022, 08:11 PM
PolarPop PolarPop is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2021
Novice
Replace lines of text from header in multiple files
 
Join Date: May 2022
Posts: 4
PolarPop is on a distinguished road
Default

So, for my understanding, you defined two ranges that cover the number of characters in the target and the number of characters in the template (screen). And then the macro is replacing the target with the screen. This is awesome!

Is it possible to do this with lines, paragraphs or some combination (characters in the target document and paragraphs in the screen document) or does the character count make it the easiest? And does the character count for each document have to match?
Reply With Quote
  #4  
Old 05-25-2022, 08:39 PM
Guessed's Avatar
Guessed Guessed is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

It is possible to do it accurately with paragraphs or characters. Paul coded it according to the information you gave him.

Unfortunately, Word isn't good with 'lines' because that is a liquid concept because of column width, font size, typeface etc. So when you specified 3 lines we don't know exactly what that means.

The source and target ranges can be defined in terms of paragraphs or characters - both are independent of each other.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #5  
Old 05-25-2022, 09:17 PM
PolarPop PolarPop is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2021
Novice
Replace lines of text from header in multiple files
 
Join Date: May 2022
Posts: 4
PolarPop is on a distinguished road
Default

What Mr. Edstein did is perfect. I wish I knew a fraction of what he does. I have searched this forum in the past and the solutions he comes up with over and over again are amazing. I meant no offense.

I just want to understand what the possibilities are and how I can utilize it in other ways. I want to learn how it works so if my character count was off or changes in the future, I can modify the solution that was provided.

For clarification, in my documents, 3 lines would be closely defined as 3 rows. The first is document number, the second is the document effective date, and the third is the page number (page x of y). Each line ends with a ^p. I now realize that may run into an issue where longer documents would have 53 characters versus the number 52 that I provided.

What does this do?
Code:
wdRngTgt.FormattedText = wdRngSrc.FormattedText

Last edited by PolarPop; 05-25-2022 at 09:39 PM. Reason: Updated
Reply With Quote
  #6  
Old 05-26-2022, 07:53 AM
macropod's Avatar
macropod macropod is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2016
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 PolarPop View Post
For clarification, in my documents, 3 lines would be closely defined as 3 rows. The first is document number, the second is the document effective date, and the third is the page number (page x of y). Each line ends with a ^p.
That means you have 3 paragraphs, not merely a paragraph of 3 lines, in which case -and assuming you want to replace those 3 paragraphs - you could use:
Code:
                                Set wdRngTgt = .Range.Paragraphs.First
                                wdRngTgt.MoveEnd wdParagraph, 2
                                Set wdRngSrc = wdDocSrc.Sections.First.Headers(HdFt.Index).Range.Paragraphs.First
                                wdRngSrc.MoveEnd wdParagraph, 2
                                wdRngTgt.FormattedText = wdRngSrc.FormattedText
Quote:
Originally Posted by PolarPop View Post
What does this do?
Code:
wdRngTgt.FormattedText = wdRngSrc.FormattedText
This does essentially the same as a copy/paste that preserves the source formatting, but without using the clipboard.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #7  
Old 05-27-2022, 01:43 PM
PolarPop PolarPop is offline Replace lines of text from header in multiple files Windows 10 Replace lines of text from header in multiple files Office 2021
Novice
Replace lines of text from header in multiple files
 
Join Date: May 2022
Posts: 4
PolarPop is on a distinguished road
Default

Thank you for taking the time to explain this and for all of your help! I have learned so much from reading your posts on this and many other questions.

Thanks again!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Replace lines of text from header in multiple files Replace or apply new header in multiple files Carchee Word VBA 41 01-26-2024 07:27 AM
Doc with autoformatted lines not printing text or header - only lines klunsford11 Word 2 08-07-2020 09:12 PM
VBA to find text, replace with multiple lines of text noslenwerd Word VBA 3 12-31-2019 11:04 AM
Find and replace header text across multiple files LG1972 Excel 1 12-25-2018 04:27 AM
Trying to add space between lines of bulleted text and a new header but both lines are moving??? Martin_d35 Word 2 02-10-2017 07:13 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:49 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