パスワード保護マクロが機能しない

Question

パスワードを一度にたくさんのExcelファイルを保護するマクロを作成しようとしています。私は、使用するファイルパスとパスワードを要求し、次にフォルダ内の各ファイルを順番に調べてパスワードを保護する必要がある次のものを解決することに成功しました（「Frankenstein-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 

私はあなたがちょうどあなたのパスの最後の\を欠落していた

TEST 

Answer 1

パス

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

とパスワードを使用しています、私が追加しました入力されたパスを強制的に終了させます。

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