密码保护目录中的多个文件答案

【问题标题】：Password protecting multiple files in a directory密码保护目录中的多个文件
【发布时间】：2015-10-26 14:16:09
【问题描述】：

我有一个包含 50 个 .xlsx 文件的目录。我需要将这些发送给某人，由于他们的工作环境限制，我无法使用 Winzip。

我之前手动对每个单独的 .xlsx 文件进行了密码保护，但我想知道是否有自动化的方法可以做到这一点？这是因为我会定期更新这些文件（为方便起见删除密码），然后在发送前重新应用密码。

【问题讨论】：

标签： excel passwords password-protection excel-2013

【解决方案1】：

以下 VBA 例程将打开所有文件（您不会看到它）并将使用密码或不使用密码保存它们。

Option Explicit

Const FOLDER As String = "C:\Temp\Test xl file bulk pw protection\"
Const PASSWORD As String = "weakpassword"
Dim app As Excel.Application
Dim strFile As String
Dim wb As Workbook

Sub Password_ON()
    Set app = New Excel.Application
    strFile = Dir(FOLDER)
    app.DisplayAlerts = False
    Do While Len(strFile) > 0
        Set wb = app.Workbooks.Open(FOLDER & strFile)
        wb.SaveAs wb.FullName, , PASSWORD
        wb.Close
        strFile = Dir
    Loop
    app.DisplayAlerts = True
    app.Quit
    Set app = Nothing
End Sub

Sub Password_OFF()
    Set app = New Excel.Application
    strFile = Dir(FOLDER)
    app.DisplayAlerts = False
    Do While Len(strFile) > 0
        Set wb = app.Workbooks.Open(FOLDER & strFile, , , , PASSWORD)
        wb.SaveAs wb.FullName, , vbNullString
        wb.Close
        strFile = Dir
    Loop
    app.DisplayAlerts = True
    app.Quit
    Set app = Nothing
End Sub

由于打开和关闭文件需要时间，这不是一个非常快速的过程。以下例程实际上并不快，但它们心理上更快，您可以在状态栏中看到正在处理的文件。 p>

Sub Password_ON()
    Set app = New Excel.Application
    strFile = Dir(FOLDER)
    app.DisplayAlerts = False
    Do While Len(strFile) > 0
        Application.StatusBar = "Processing " & strFile
        DoEvents
        Set wb = app.Workbooks.Open(FOLDER & strFile)
        wb.SaveAs wb.FullName, , PASSWORD
        wb.Close
        strFile = Dir
    Loop
    app.DisplayAlerts = True
    app.Quit
    Set app = Nothing
    Application.StatusBar = "READY"
End Sub

Sub Password_OFF()
    Set app = New Excel.Application
    strFile = Dir(FOLDER)
    app.DisplayAlerts = False
    Do While Len(strFile) > 0
        Application.StatusBar = "Processing " & strFile
        DoEvents
        Set wb = app.Workbooks.Open(FOLDER & strFile, , , , PASSWORD)
        wb.SaveAs wb.FullName, , vbNullString
        wb.Close
        strFile = Dir
    Loop
    app.DisplayAlerts = True
    app.Quit
    Set app = Nothing
    Application.StatusBar = "READY"
End Sub

【讨论】：