vba 批量删除word文档页眉与最后一页代码【北大法宝】

Sub 批量获取文件()
    Dim fPk As FileDialog, fName, fType As String, 后缀 As String, t0, 计数
    t0 = Timer
    Set fPk = Application.FileDialog(msoFileDialogFilePicker)
    With fPk
        .AllowMultiSelect = True
        .InitialFileName = "C:\Users\CJ\Desktop"
        .Show
        fType = InputBox("请输入文件类型（支持通配符，如“doc*”）：", "文件类型", "doc*")
        If .SelectedItems.Count > 0 Then
            For Each fName In .SelectedItems
                If fType = "" Then
                    MsgBox "文件类型为空，将退出程序！", vbInformation, "出错提示"
                    Exit Sub
                Else
                    后缀 = Right(fName, Len(fName) - InStrRev(fName, "."))
                    If 后缀 Like fType Then
                        Call 处理过程_删除页眉页脚(fName)
                        计数 = 计数 + 1
                    End If
                End If
            Next
        Else
            MsgBox "您未选择文件，将退出程序！", vbInformation, "出错提示"
            Exit Sub
        End If
    End With
    Set fPk = Nothing
    If 计数 > 0 Then
        Debug.Print "完成，共处理了" & 计数 & "个文件。用时" & Timer - t0 & "秒。"
        MsgBox "完成，共处理了" & 计数 & "个文件。用时" & Timer - t0 & "秒。"
    Else
        Debug.Print "完成，没有类型符合要求的文件。用时" & Timer - t0 & "秒。"
        MsgBox "完成，没有类型符合要求的文件。用时" & Timer - t0 & "秒。"
    End If
End Sub

Sub 处理过程_删除页眉页脚(fName)
    Dim aDoc As Document
    Application.ScreenUpdating = False
    Set aDoc = Documents.Open(fName)
    '此处以下写对文d件的具体处理过程

    Dim HF As HeaderFooter, Sec As Section, rng As Range, pageCount As Integer
    For Each Sec In aDoc.Sections
        For Each HF In Sec.Headers
            HF.Range.Delete
        Next

            ' work out how many pages

        pageCount = aDoc.ComputeStatistics(wdStatisticPages)
        ' set a range from page 3 to the end
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageCount
        Set rng = Selection.Range
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=pageCount
        rng.End = Selection.Bookmarks("\Page").Range.End

        ' delete the range
        rng.Delete

        ' optionally remove the left over blank page
        Selection.TypeBackspace
        Selection.TypeBackspace
    Next

    Debug.Print "已完成对文件《" & aDoc.FullName & " 》的处理。 "

    '此处以上写对文件的具体处理过程
    aDoc.Close wdSaveChanges
    Application.ScreenUpdating = True
    Set aDoc = Nothing
End Sub