Microsoft Office Forums - View Single Post - [Solved] Replace or apply new header in multiple files

kykyryky · 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.