Hello,
first of all, thank you for putting this useful thing together.
Yet it does not work for me. What I do:
1. Create a .bas file with the text stated above:
Code:
Attribute VB_Name = "Update_headers_footers"
Sub UpdateDocumentHeaders()
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
.Range.FormattedText = _
wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
.Range.Characters.Last = vbNullString
ElseIf .LinkToPrevious = False Then
.Range.FormattedText = _
wdDocSrc.Sections.First.Headers(HdFt.Index).Range.FormattedText
.Range.Characters.Last = vbNullString
End If
End If
End With
Next
'For footers
For Each HdFt In Sctn.Footers
With HdFt
If .Exists Then
If Sctn.Index = 1 Then
.Range.FormattedText = _
wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
.Range.Characters.Last = vbNullString
ElseIf .LinkToPrevious = False Then
.Range.FormattedText = _
wdDocSrc.Sections.First.Footers(HdFt.Index).Range.FormattedText
.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. left alt+F11, import, save, open macros:
3. then it prompts me to select a folder for some reason, I pick the one with the file(s) and then - nothing happens.
Tried this one mentioned above which copies the header to footer, which works just fine.
Misght I ask for a help, please? I am practically illiterate when it comes to scripting. Only using macros I get hold of.
Thank you!
EDIT:
1. It works when the file is saved on local. Can this be adjsuted somehow, please?
2. It does not do exactly what wanted. It is messed up. Will have the time to create a non-confidential document and upload sample details later.