vba word 批量删除批注

vba word 批量删除批注

Sub 批量删除批注()

批量删除批注 Macro

Dim fPk As FileDialog, fame, fType As String, 后缀 As String, t0, 计数

t0 = Timer

Set fPk = Application.FileDialog(msoFileDialogFilePicker)

With fPk

.AllowMultiSelect = True

.InitialFileame = 注意在此处放入需要处理word文件的文件夹地址

.Show

fType = InputBox(请输入文件类型（支持通配符，如“doc*”）：, 文件类型, doc*)

If .SelectedItems.Count > 0 Then

For Each fame In .SelectedItems

If fType =  Then

MsgBox 文件类型为空，将退出程序！, vbInformation, 出错提示

Exit Sub

Else

后缀 = Right(fame, Len(fame) - InStrRev(fame, .))

If 后缀 Like fType Then

Call 删除批注(fame)

计数 = 计数  1

End If

End If

ext

Else

MsgBox 您未选择文件，将退出程序！, vbInformation, 出错提示

Exit Sub

End If

End With

Set fPk = othing

If 计数 > 0 Then

Debug.Print 完成，共处理了 & 计数 & 个文件。用时 & Timer - t0 & 秒。

MsgBox 完成，共处理了 & 计数 & 个文件。用时 & Timer - t0 & 秒。

Else

Debug.Print 完成，没有类型符合要求的文件。用时 & Timer - t0 & 秒。

MsgBox 完成，没有类型符合要求的文件。用时 & Timer - t0 & 秒。

End If

End Sub

Sub 删除批注(fame)

Dim aDoc As Document

Application.ScreenUpdating = False

Set aDoc = Documents.Open(fame)

此处以下写对文件的具体处理过程

If aDoc.ProtectionType = Then

aDoc.Unprotect Password:=q

End If

Selection.SetRange Start:=7497, End:=7497

aDoc.DeleteAllComments

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

此处以上写对文件的具体处理过程

aDoc.Close wdSaveChanges

Application.ScreenUpdating = True

Set aDoc = othing

End Sub