Hi Guessed,
Thanks for the guidance. I tried first one which change all heading it's work.
Second choice doesn't work for my files and dont have any message error when running the code. Would like to ask about your comment regarding to my code as below:
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
'For Heading 1 start at page 3
wdDocTgt.Range.GoTo(What:=wdGoToHeading, Which:=wdGoToFirst).ParagraphFormat.PageBreakBefor e = True
wdDocTgt.PageSetup.FooterDistance = InchesToPoints(0.6)
wdDocTgt.PageSetup.HeaderDistance = InchesToPoints(0.8)
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
Thanks!
|