最近有个需求,需要批量给doc文件增加文档保护,防止用户修改,网上搜索了一段代码,测试可用,贴出来分享
'* +++++++++++++++++++++++++++++
'* Created By SHOUROU@ExcelHome 2008-5-28 6:54:51
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0410^The Code CopyIn [ThisDocument-ThisDocument]^'
'* -----------------------------
Option Explicit
Sub batchProtect()
Dim myDialog As FileDialog
Dim oFile As Variant
Dim oDoc As Document
Dim myResult As VbMsgBoxResult
Dim myPassWord As String
On Error Resume Next
myPassWord = "yourpassword"
'定义一个文件夹选取对话框
Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
With myDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show <> -1 Then Exit Sub
myResult = MsgBox("选择是将进行对所选文件的设置文档保护,选择否将解除文档保护!", vbYesNo)
For Each oFile In .SelectedItems '在所有选取项目中循环
Set oDoc = Documents.Open(FileName:=oFile, Visible:=False)
With oDoc
If myResult = vbYes Then '如果选择了进行文档保护
'如果该文档未经过保护则使用保护窗体(文档)功能
If .ProtectionType = wdNoProtection Then .Protect Type:=wdAllowOnlyComments, Password:=myPassWord
Else '如果选择了取消文档保护
'如果文档已使用了保护文档的功能,则解除文档保护
If .ProtectionType <> wdNoProtection Then .Unprotect myPassWord
End If
.Close True
End With
Next
End With
End Sub