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

我试图创build一个macros，将密码保护一堆excel文件一次。 我已经设法（请阅读“从各种来源和旧代码的科学怪人”）下面应该要求一个文件path和密码使用，然后循环访问文件夹中的每个文件和密码保护他们。 不幸的是，它请求的path和密码，但它立即结束没有密码保护文件。 我的vba基本上都是在这个时候生锈，所以我不幸地努力工作，为什么它不工作。

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

有没有人有任何想法？

码：

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 

我正在使用path

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

和密码

 TEST 

Answer 1

你只是错过了最后的path，我添加了一行来强制inputpath。

此外，无需尝试closuresSaveAs之后的初始工作簿，因为它已经更改。

 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