批量删除word文档某一页 VBA

使用Dir函数，把你的文件夹中的word文档名全部找出百来。然后用documents.open方法，逐个打开文档改度字体颜色。
参考：

Dim MyDoc$MyDoc = Dir("C:\Documents and Settings\user\My Documents\*.doc")Debug.Print MyDocDo While MyDoc <> "" MyDoc = Dir Debug.Print MyDocLoop

open方法是这样：
Documents.Open FileName:=ThisDocument.Path & "\" & MyDoc
你自己整合一起吧，这就不多说了内。

你的那些关键容字，没必要用字典保存啊，用Array函数更方便了。
Dim KeyWords as Variant
KeyWords=Array("关键词1",“关键词2”,……)

vba 批量删除 word 内容吗？
Sub Macro4()
Dim i As Paragraph
Application.ScreenUpdating = False
For Each i In ActiveDocument.Paragraphs
Selection.Find.ClearFormatting
Selection.Find.Text = "所含的关抄键袭字"
Selection.Find.Execute
If Selection.Text <> "" Then
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
End If
Next
End Sub
把代码中所含的关键字几个字改成你百想要的就可以了度

Public StartPageNum As Integer, EndPageNum As Integer

Sub aaa()

Dim myDialog As FileDialog, oFile As Variant, oDoc As Document
On Error Resume Next

Set myDialog = Application.FileDialog(msoFileDialogFilePicker)

myDialog.Filters.Clear '清除所有文件筛选器中的项目
myDialog.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
myDialog.AllowMultiSelect = True '允许多项选择

If myDialog.Show <> -1 Then Exit Sub

Dim SelectRange As Range
DlgDelePage.Show vbModal
If StartPageNum = 0 And EndPageNum = 0 Then
Exit Sub
End If

For Each oFile In myDialog.SelectedItems '在所有选取项目中循环

Set oDoc = Documents.Open(FileName:=oFile, Visible:=True) 'False)

Dim Pages As Integer, StartPage As Long, EndPage As Long

Pages = Selection.Information(wdNumberOfPagesInDocument)

If Not (StartPageNum > Pages) Then
If EndPageNum > Pages Then EndPageNum = Pages

If StartPageNum = 1 Then
StartPage = Selection.Range
Else
StartPage = Selection.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Count:=StartPageNum - 1).Start
End If

If EndPageNum = Pages Then
EndPage = ActiveDocument.Content.End
Else
EndPage = Selection.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Count:=IIf(EndPageNum - StartPageNum > 0, EndPageNum - StartPageNum + 1, 1)).End '.Start
End If

ActiveDocument.Range(StartPage, EndPage).Select
Selection.Delete

End If

'删除第e79fa5e98193e58685e5aeb93343页批注
ActiveDocument.Words(1).Select '将光标移到文档开始位置
Dim myRange As Range, oComment As Comment
Set myRange = Selection.Range
StartPage = Selection.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Count:=3 - 1).Start
EndPage = Selection.GoTo(What:=wdGoToPage, Which:=wdGoToNext, Count:=3 - 1).End

myRange = ActiveDocument.Range(StartPage, EndPage)

If myRange.Comments.Count > 0 Then
For Each oComment In myRange.Comments
oComment.Delete
Next
End If

oDoc.Save
oDoc.Close

Next oFile

End Sub