Question

我正在尝试创建一个可以一次密码保护一堆excel文件的宏。我已经设法解决了（请阅读“Frankenstein-from-various-sources-and-old-code”）以下应该请求文件路径和密码使用，然后循环浏览文件夹中的每个文件和密码保护他们。不幸的是，它请求路径和密码，但它立即结束，没有密码保护文件。我的vba基本上都是生锈的，所以我很遗憾地努力找出它为什么不起作用。

是的，我知道这不是最佳做法。不幸的是，我有几百个文件要密码保护，没时间做这个。

有没有人有任何想法？

CODE：

Sub ProtectAll()
Dim wBk As Workbook
Dim sFileSpec As String
Dim sPathSpec As String
Dim sFoundFile As String
Dim sPassword As String

sPathSpec = InputBox("Path to use", "Path")
sPassword = InputBox("Enter Password Below", "Password")
sFileSpec = "*.xlsx"

sFoundFile = Dir(sPathSpec & sFileSpec)
Do While sFoundFile <> ""
    Set wBk = Workbooks.Open(sPathSpec & sFoundFile)
    With wBk
        Application.DisplayAlerts = False
        wBk.SaveAs Filename:=.FullName, _
          Password:=sPassword
        Application.DisplayAlerts = True
    End With
    Set wBk = Nothing
    Workbooks(sFoundFile).Close False
    sFoundFile = Dir
Loop
End Sub

我正在使用路径

C:\Users\ [MYNAME] \Desktop\Password Test

和密码

TEST

Answer 1

你刚刚错过了路径中的最后一个\，我添加了一行来强制使用它完成输入路径。

此外，无需尝试在SaveAs之后关闭初始工作簿，因为它已经更改。

Sub ProtectAll()
Dim wBk As Workbook
Dim sFileSpec As String
Dim sPathSpec As String
Dim sFoundFile As String
Dim sPassword As String

sPathSpec = InputBox("Path to use", "Path")
If Right(sPathSpec, 1) <> "\" Then sPathSpec = sPathSpec & "\"
sPassword = InputBox("Enter Password Below", "Password")
sFileSpec = "*.xlsx"

sFoundFile = Dir(sPathSpec & sFileSpec)
Do While sFoundFile <> vbNullString
    Set wBk = Workbooks.Open(sPathSpec & sFoundFile)
    With wBk
        Application.DisplayAlerts = False
        .SaveAs filename:=.FullName, Password:=sPassword
        Application.DisplayAlerts = True
        .Close
    End With
    Set wBk = Nothing
    sFoundFile = Dir
Loop
End Sub

密码保护宏将无法正常工作

1 个答案: