Replace or apply new header in multiple files

kykyryky · #33 01-25-2024, 08:24 AM

Thank you. Yet this is a bit confusing to me, honestly. Looking for where to paste it and such.

Anyway:

1. This (header to footer) seemed to work before, yet now the same code gives me an error.

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

Both for dummy files and our corporate ones. Any idea, please? I am not aware of changing anything from the time it worked these several hours ago.

Edit: Seems not/to work randomly on exactly the same files, machine, everyhing.

2. This (header to other docs) does not do anything if on a mapped network drive (simply nothing happens), and somehow (so far incorrectly, more later) works on local. Can this be solved in some manner, please? Could it be due to access restrictions/authentication? Yet me myself, I do have access with full rights there in the folders.

Code:

Sub UpdateDocumentHeaders()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, StrTxt As String
Dim wdDocTgt As Document, wdDocSrc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
StrTxt = InputBox("Text to add to headers? e.g. ""March 1, 2018""")
If Trim(StrTxt) = "" 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
            .Sections(1).Headers(wdHeaderFooterPrimary).Range.InsertAfter StrTxt
            .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

Once again, huge thanks for doing this.

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