各位网友，大家好。

今天给大家介绍如何用vba批量给excel工作簿设置添加打开密码。

今天的内容主要分为以下三个部分：

1. 手动设置添加打开密码；
2. 在vba中用工作簿Workbook对象的SaveAs方法设置添加打开密码；
3. 在vba中用工作簿Workbook对象的Password属性的方式设置添加打开密码。

一、手动设置添加打开密码

在excel中，如果想要给某个工作簿添加打开密码，可以在“另存为”对话框中的“工具”按钮内的“常规选项”中进行设置，如下图所示：

二、在vba中用工作簿Workbook对象的SaveAs方法设置添加打开密码

在vba中可以直接使用Workbook对象的SaveAs方法在将某个工作簿另存为时，设置添加打开密码。

它的语法如下：

expression.SaveAs (FileName, FileFormat, Password, WriteResPassword, ReadOnlyRecommended, CreateBackup, AccessMode, ConflictResolution, AddToMru, TextCodepage, TextVisualLayout, Local)

其中参数Password表示打开密码。

以下是一个将当前excel工作簿另存为具有打开密码”abc”的vba代码：

Sub QQ1722187970()
    Dim oWB As Workbook
    Set oWB = Excel.ThisWorkbook
    oWB.SaveAs "d:\test.xlsm", xlOpenXMLWorkbookMacroEnabled, "abc"
End Sub

执行上述代码后保存关闭，重新打开excel工作簿会弹出输入打开密码的提示，如下图所示：

三、在vba中用工作簿Workbook对象的Password属性的方式设置添加打开密码

除了可以用Workbook对象的SaveAs方法在将某个工作簿另存为时，设置添加打开密码外，还可以通过直接设置Workbook对象的Password属性值的方式给excel工作簿设置打开密码。

以下是为当前excel工作簿设置打开密码”abc”的vba代码：

Sub QQ1722187970()
    Dim oWB As Workbook
    Set oWB = Excel.ThisWorkbook
    oWB.Password = "abc"
End Sub

用这种方法设置打开密码，不仅可以为尚未设置打开密码的excel工作簿添加打开密码，还可以修改已经有打开密码的excel工作簿的密码为其它密码。

四、批量给同一文件夹下的所有Excel工作簿添加打开密码

如果要批量给同一文件夹下的所有Excel工作簿添加打开密码，可以使用如下的代码：

Sub QQ1722187970()
    Excel.Application.Calculation = xlCalculationManual
    Excel.Application.DisplayAlerts = False
    Dim oWB As Workbook
    Dim sPath As String
    sPath = GetPath
    Dim sResult As String
    '查找第一个文件,第一次使用dir函数
    sResult = Dir(sPath & "\*.xls*")
    If Len(sResult) Then
            Set oWB = Excel.Workbooks.Open(sPath & "\" & sResult)
            oWB.SaveAs sPath & "\" & sResult, , "test"
            oWB.Close
            Debug.Print sResult
        Do
            '重复使用dir函数，此时不用输入任何参数
            sResult = Dir
            Debug.Print sResult
            If Len(sResult) Then
                Set oWB = Excel.Workbooks.Open(sPath & "\" & sResult)
                oWB.SaveAs sPath & "\" & sResult, , "test"
                oWB.Close
            End If
            '直到返回的字符串为空字符串，表示遍历结束
        Loop Until Len(sResult) = 0
    End If
    Excel.Application.DisplayAlerts = True
    Excel.Application.Calculation = xlCalculationAutomatic
End Sub
Function GetPath() As String
    '声明一个FileDialog对象变量
    Dim oFD As FileDialog
'    '创建一个选择文件对话框
'    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    '创建一个选择文件夹对话框
    Set oFD = Application.FileDialog(msoFileDialogFolderPicker)
    '声明一个变量用来存储选择的文件名或者文件夹名称
    Dim vrtSelectedItem As Variant
    With oFD
        '允许选择多个文件
        .AllowMultiSelect = True
        '使用Show方法显示对话框，如果单击了确定按钮则返回-1。
        If .Show = -1 Then
            '遍历所有选择的文件
            For Each vrtSelectedItem In .SelectedItems
                '获取所有选择的文件的完整路径,用于各种操作
                GetPath = vrtSelectedItem
            Next
            '如果单击了取消按钮则返回0
        Else
        End If
    End With
    '释放对象变量
    Set oFD = Nothing
End Function