如何使用vba批量删除文件夹中所有文档的页眉和页脚？

focuson1

新建文件夹.rar (49.29 KB, 下载次数: 21)

2017-3-4 10:04 上传

点击文件名下载附件

以上文件夹是一些word文件，如何才能使用vba批量删除每一个文件中的页眉和页脚呢？

duquancai

可以。。。。。。。。。

focuson1

1. Sub 批量删除Word页眉页脚()
   
2.   Application.ScreenUpdating = False
   
3.   Dim MyPath As String, i As Integer, myDoc As Document
   
4.   With Application.FileDialog(msoFileDialogFolderPicker)
   
5.     .Title = "选择要处理目标文件夹" & "——(删除里面所有Word文档的页眉页脚)"
   
6.     If .Show = -1 Then
   
7.       MyPath = .SelectedItems(1)
   
8.     Else
   
9.       Exit Sub
   
10.     End If
    
11.   End With
    
12.   With Application.FileSearch
    
13.     .LookIn = MyPath
    
14.     .FileType = msoFileTypeWordDocuments
    
15.     If .Execute > 0 Then
    
16.       For i = 1 To .FoundFiles.Count
    
17.         Set myDoc = Documents.Open(FileName:=.FoundFiles(i))
    
18.       ' B可以替换的宏
    
19. ' 以下是处理格式所录制的宏，可根据所需录制
    
20. If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    
21. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;ActiveWindow.Panes(2).Close
    
22. &nbsp; &nbsp; End If
    
23. &nbsp; &nbsp; If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
    
24. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;ActivePane.View.Type = wdOutlineView Then
    
25. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;ActiveWindow.ActivePane.View.Type = wdPrintView
    
26. &nbsp; &nbsp; End If
    
27. &nbsp; &nbsp; ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    
28. &nbsp; &nbsp; Selection.WholeStory
    
29. &nbsp; &nbsp; Selection.Delete Unit:=wdCharacter, Count:=1
    
30. &nbsp; &nbsp; Selection.WholeStory
    
31. &nbsp; &nbsp; With Selection.ParagraphFormat
    
32. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    
33. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Borders(wdBorderRight).LineStyle = wdLineStyleNone
    
34. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Borders(wdBorderTop).LineStyle = wdLineStyleNone
    
35. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    
36. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;With .Borders
    
37. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;.DistanceFromTop = 1
    
38. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;.DistanceFromLeft = 4
    
39. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;.DistanceFromBottom = 1
    
40. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;.DistanceFromRight = 4
    
41. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;.Shadow = False
    
42. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;End With
    
43. &nbsp; &nbsp; End With
    
44. &nbsp; &nbsp; With Options
    
45. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.DefaultBorderLineStyle = wdLineStyleSingle
    
46. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.DefaultBorderLineWidth = wdLineWidth075pt
    
47. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.DefaultBorderColor = wdColorAutomatic
    
48. &nbsp; &nbsp; End With
    
49. &nbsp; &nbsp; If Selection.HeaderFooter.IsHeader = True Then
    
50. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    
51. &nbsp; &nbsp; Else
    
52. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    
53. &nbsp; &nbsp; End If
    
54. &nbsp; &nbsp; Selection.WholeStory
    
55. &nbsp; &nbsp; Selection.Delete Unit:=wdCharacter, Count:=1
    
56. &nbsp; &nbsp; ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
57. &nbsp; &nbsp; Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
    
58. &nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;wdAlignPageNumberRight, FirstPage:=True
    
59. ' 以上可以换成是你自己录制的宏
    
60. ' C公共部分的代码
    
61. Application.DisplayAlerts = False '强制执行“是”
    
62. 'ActiveDocument.Saved = True'强制执行“否”
    
63. ActiveDocument.Close '退出
    
64. &nbsp; &nbsp;&nbsp; &nbsp;Next
    
65. &nbsp; &nbsp; End If
    
66. &nbsp;&nbsp;End With
    
67. &nbsp;&nbsp;Application.ScreenUpdating = True
    
68. &nbsp;&nbsp;MsgBox "所选Word文档的页眉页脚已删除！！！", 64, "☆★批量处理完毕★☆"
    
69. End Sub

复制代码

focuson1

　　Sub 批量删除页眉页脚()
　　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

lsc900707

这是守柔版主的代码，请测试：
Option Explicit
Sub Example()    '此代码功能为列出指定文件夹中所有选取的WORD文件全路径名
    Dim myDialog As FileDialog, oDoc As Document, oSec As Section
    Dim oFile As Variant, myRange As Range
    On Error Resume Next
    '定义一个文件夹选取对话框
    Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
    With myDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            For Each oFile In .SelectedItems    '在所有选取项目中循环
                Set oDoc = Word.Documents.Open(FileName:=oFile, Visible:=False)
                For Each oSec In oDoc.Sections    '文档的节中循环
                    Set myRange = oSec.Headers(wdHeaderFooterPrimary).Range
                    myRange.Delete    '删除页眉中的内容
                    myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone    '段落下边框线
                    Set myRange = oSec.Footers(wdHeaderFooterPrimary).Range
                    myRange.Delete    '删除页脚中的内容
                Next
                oDoc.Close True
            Next
        End If
    End With
End Sub

focuson1

lsc900707 发表于 2017-3-4 11:20
这是守柔版主的代码，请测试：
Option Explicit
Sub Example()    '此代码功能为列出指定文件夹中所有选 ...

这段代码能够删除页眉页脚也能删除背景图片和水印？

focuson1

Option Explicit
Sub Example()&nbsp; &nbsp; '此代码功能为列出指定文件夹中所有选取的WORD文件全路径名
&nbsp; &nbsp; Dim myDialog As FileDialog, oDoc As Document, oSec As Section
&nbsp; &nbsp; Dim oFile As Variant, myRange As Range
&nbsp; &nbsp; On Error Resume Next
&nbsp; &nbsp; '定义一个文件夹选取对话框
&nbsp; &nbsp; Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
&nbsp; &nbsp; With myDialog
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Filters.Clear&nbsp; &nbsp; '清除所有文件筛选器中的项目
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.Filters.Add "所有 WORD 文件", "*.doc", 1&nbsp; &nbsp; '增加筛选器的项目为所有WORD文件
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;.AllowMultiSelect = True&nbsp; &nbsp; '允许多项选择
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;If .Show = -1 Then&nbsp; &nbsp; '确定
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;For Each oFile In .SelectedItems&nbsp; &nbsp; '在所有选取项目中循环
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp; Set oDoc = Word.Documents.Open(FileName:=oFile, Visible:=False)
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp; For Each oSec In oDoc.Sections&nbsp; &nbsp; '文档的节中循环
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;Set myRange = oSec.Headers(wdHeaderFooterPrimary).Range
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;myRange.Delete&nbsp; &nbsp; '删除页眉中的内容
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;myRange.ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleNone&nbsp; &nbsp; '段落下边框线
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;Set myRange = oSec.Footers(wdHeaderFooterPrimary).Range
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;myRange.Delete&nbsp; &nbsp; '删除页脚中的内容
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp; Next
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp; oDoc.Close True
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;&nbsp; &nbsp;Next
&nbsp; &nbsp;&nbsp; &nbsp;&nbsp;&nbsp;End If
&nbsp; &nbsp; End With
End Sub

如果要遍历所有文件夹中的文件以及文件夹中的子文件夹等等要如何更改代码？

focuson1

lsc900707 发表于 2017-3-4 11:20
这是守柔版主的代码，请测试：
Option Explicit
Sub Example()    '此代码功能为列出指定文件夹中所有选 ...

如果要遍历所有文件夹中的文件以及文件夹中的子文件夹等等要如何更改代码？

1834689

lsc900707 发表于 2017-3-4 11:20
这是守柔版主的代码，请测试：
Option Explicit
Sub Example()    '此代码功能为列出指定文件夹中所有选 ...

感谢分享！！！