批量给doc文件增加文档保护

     最近有个需求，需要批量给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