同じパスワードが設定されている複数のブックのパスワードをまとめて解除する。

　●同一のパスワードをまとめて解除

'******************************************************************
'　Excelファイルのパスワード解除（同一パスワードのみ）
'******************************************************************
Sub unlockBookPassword()
    
    'フォルダの指定
    Dim sSetDir As String
    sSetDir = "C:\VBA\PassSet\"
    
    'パスワードの指定
    Dim sPass As String
    sPass = "pass123"
    
    
    'フォルダ内のブック全てにパスワードを解除
    Debug.Print unlockBookPwdInDir(sSetDir, sPass)
    MsgBox "完了"

End Sub


'******************************************************************
'　指定のパスワードが掛かっているブックのパスワードを解除
'------------------------------------------------------------------
'　　第１引数：指定フォルダのパス
'　　第２引数：設定されているパスワード
'------------------------------------------------------------------
'　　戻り値　：実行結果
'******************************************************************
Function unlockBookPwdInDir(sDirPath As String, sPassword As String) As String
    
    Dim sRtn As String
    
    'FileSystemObjectの作成
    Dim oFso As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    
    'フォルダオブジェクトの取得
    Dim oDir As Object
    Set oDir = oFso.GetFolder(sDirPath)
    
    '表示とメッセージの制御
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'フォルダにあるファイル一覧の取得
    Dim fFile As Object
    For Each fFile In oDir.Files
        
        'Excelファイルであれば処理(一時ファイル（~$）は処理対象外)
        If (oFso.GetExtensionName(fFile.Name) Like "xls*") And _
           (Left(fFile.Name, 2) <> "~$") Then
            
            'ファイルパス取得
            Dim sFilePath As String
            sFilePath = sDirPath & fFile.Name
            
            '対象のブックを開く
            On Error Resume Next
            Dim oWb As Object
            
            '※パスワードが掛かっているファイルを指定のパスで開く。
            Set oWb = Workbooks.Open(sFilePath, UpdateLinks:=0, password:=sPassword)
            
            '指定のパスワードが掛かっているファイルのみ処理。
            If Err.Number = 0 Then
                'パスワードに空文字を設定
                oWb.SaveAs fileName:=sFilePath, password:=""
                oWb.Close
                sRtn = sRtn & fFile.Name & " のパスワードを解除しました。" & vbCrLf
            Else
                sRtn = sRtn & fFile.Name & " は指定外のパスワード、もしくはパスワードが設定されてません。" & vbCrLf
            End If
            On Error GoTo 0
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set oFso = Nothing
    unlockBookPwdInDir = sRtn
End Function

　■実行結果