#1
|
|||
|
|||
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 |
#2
|
||||
|
||||
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] |
#3
|
|||
|
|||
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? |
#4
|
||||
|
||||
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 |
#5
|
|||
|
|||
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 |
#6
|
||||
|
||||
Quote:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
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! |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
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 |