如何批量删除一个文件夹下所有Word文件的页眉和页脚？

wfufn

如何批量删除一个文件夹下所有Word文件的页眉和页脚？
哪位大大帮帮忙，麻烦说清楚点，之前也看了个这种贴，但是看不明白！拜托说清楚点

youliqi

不知道通过VBA能否实现
一般方法好像还没有听说过

moldok

我觉得笨一点的办法是做成宏，宏里包括删除页眉、页脚并保存、关闭、打开文件，这样你只要再点下一个文件就好了，它就又继续了。

szqhb

用下面一段代码试一下
Sub 批量删除Word页眉页脚()
  Application.ScreenUpdating = False
  Dim MyPath As String, i As Integer, myDoc As Document
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "选择要处理目标文件夹" & "——(删除里面所有Word文档的页眉页脚)"
    If .Show = -1 Then
      MyPath = .SelectedItems(1)
    Else
      Exit Sub
    End If
  End With
  With Application.FileSearch
    .LookIn = MyPath
    .FileType = msoFileTypeWordDocuments
    If .Execute > 0 Then
      For i = 1 To .FoundFiles.Count
        Set myDoc = Documents.Open(FileName:=.FoundFiles(i))
      ' B可以替换的宏
' 以下是处理格式所录制的宏，可根据所需录制
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.WholeStory
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.WholeStory
    With Selection.ParagraphFormat
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        With .Borders
            .DistanceFromTop = 1
            .DistanceFromLeft = 4
            .DistanceFromBottom = 1
            .DistanceFromRight = 4
            .Shadow = False
        End With
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth075pt
        .DefaultBorderColor = wdColorAutomatic
    End With
    If Selection.HeaderFooter.IsHeader = True Then
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Else
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    End If
    Selection.WholeStory
    Selection.Delete Unit:=wdCharacter, Count:=1
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
        wdAlignPageNumberRight, FirstPage:=True
' 以上可以换成是你自己录制的宏
' C公共部分的代码
Application.DisplayAlerts = False '强制执行“是”
'ActiveDocument.Saved = True'强制执行“否”
ActiveDocument.Close '退出
      Next
    End If
  End With
  Application.ScreenUpdating = True
  MsgBox "所选Word文档的页眉页脚已删除！！！", 64, "☆★批量处理完毕★☆"
End Sub

[ 本帖最后由 szqhb 于 2010-6-6 20:54 编辑 ]

tangqingfu

谢谢分享！

mingch

szqhb 发表于 2010-6-6 20:45
用下面一段代码试一下
Sub 批量删除Word页眉页脚()
  Application.ScreenUpdating = False

请问如果需要批量添加页眉和页脚呢，可能还包含图片

ghoob

我是用的软件从网上下的名字忘了

whbd1999

szqhb 发表于 2010-6-6 20:45
用下面一段代码试一下
Sub 批量删除Word页眉页脚()
  Application.ScreenUpdating = False

2007 及以后版本的Office 程序和 VBA 宏将使用Application.FileSearch对象时，会出现此问题。此对象不再支持在 2007 Office 程序。

Application.FileSearch命令不再支持office2007以后的版本了，求新代码