密碼保護宏將不起作用

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