批量去掉word文档页眉里的水印

去掉word文档页眉里的水印，在一个空白word文件里创建宏，复制代码，运行，选择目录。

Dim ArrFiles()
Dim FileCount%
‘替代filesearch的部分
Sub SearchFiles(ByVal fd As Object)
Dim fl As Object
Dim sfd As Object
For Each fl In fd.Files
If InStr(Right(fl.Path, Len(fl.Path) – InStrRev(fl.Path, “.”)), “doc”) > 0 Then
FileCount = FileCount + 1
ReDim Preserve ArrFiles(1 To FileCount)
ArrFiles(FileCount) = fl.Path
End If
Next
If fd.subfolders.Count = 0 Then Exit Sub
For Each sfd In fd.subfolders
SearchFiles sfd
Next
Set fl = Nothing
Set sfd = Nothing
End Sub

Sub 去掉页眉()
Dim DirFile As String
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
Dim fs As Object, fd As Object
Set fs = CreateObject(“Scripting.FileSystemObject”)
Set fd = fs.GetFolder(MyPath)
FileCount = 0
SearchFiles fd

‘循环数组

For i = 1 To FileCount

Set myDoc = Documents.Open(FileName:=ArrFiles(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.TypeBackspace
Selection.TypeBackspace
Selection.TypeBackspace
Selection.Delete Unit:=wdCharacter, Count:=1
ActiveDocument.Save
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Application.DisplayAlerts = False ‘强制执行“是”

ActiveDocument.Saved = True ‘强制执行“否”

ActiveDocument.Close ‘退出

Next

Application.ScreenUpdating = True

End Sub