批量删除Word 文档页眉

Sub RemoveHeadersAndFooters()
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
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "选择要处理目标文件夹" & "—(删除里面所有Word文档的页眉页脚 *.doc, *.docx)"
    If .Show = -1 Then
      strFolder = .SelectedItems(1)& "\"
    Else
      Exit Sub
    End If
End With

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, _
        Format:=wdOpenFormatAuto, Revert:=False, ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, Visible:=False)

        With wdDocTgt
            For Each Sctn In .Sections
                'For Headers
                For Each HdFt In Sctn.headers
                    HdFt.Range.Delete
                    HdFt.Range.Select
                    Selection.WholeStory
                    Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
                    Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
                    Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
                    Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
                Next
                'For footers
                For Each HdFt In Sctn.Footers
                    HdFt.Range.Delete
                Next
            Next
            .Close SaveChanges:=True
        End With
    End If
    strFile = Dir()
Wend
Set wdDocSrc = Nothing: Set wdDocTgt = Nothing
Application.ScreenUpdating = True
MsgBox "所选Word文档的页眉页脚已删除！！！", 64, "批量处理完毕"
End Sub