フォルダ内のブックファイルにパスワードが設定されているかを一括で確認する。

VBAで指定したフォルダ内のブックファイルにパスワード設定がされているかを順番に確認してその結果を一覧で返しています。

基本的な処理は「ブックにパスワードが設定されているか確認」に記載している方法と同じですが、一括での処理にあたってフォルダ内のExcelファイルの判断を拡張子でしているのでExcel一時ファイル（~$で始まるファイル）は対象外となるようにしています。

'******************************************************************
'　Excelファイルのパスワード設定確認
'*****************************************************************
Sub Main_chkPassword()

    'チェック対象のフォルダ指定
    Dim sChkDir As String
    sChkDir = "C:\VBA\pwChk\"
    
    Application.ScreenUpdating = False

    Call chkBookPwdLockInDir(sChkDir)
    
    Application.ScreenUpdating = True

End Sub

'******************************************************************
'　フォルダ内のExcelファイルにパスワードが掛かっているか順次確認
'------------------------------------------------------------------
'　　第１引数：チェック対象のパス
'******************************************************************
Sub chkBookPwdLockInDir(sDirPath As String)
    
    'フォルダオブジェクトの取得
    Dim oFso As Object
    Dim oDir As Object
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oDir = oFso.GetFolder(sDirPath)

    'フォルダにあるファイル一覧の取得
    Dim fFile As Object
    For Each fFile In oDir.Files
        
        Dim sFilePath As String
        sFilePath = sDirPath & fFile.Name
        
        'Excelファイルであればパスワード設定のチェック
        Select Case True
        Case oFso.GetExtensionName(sFilePath) Like "xls*"
            '一時ファイル（~$）は処理対象外
            If Left(fFile.Name, 2) <> "~$" Then
                
                'パスワードに""を指定しファイルを開く。
                On Error Resume Next
                Dim oWb As Object
                'Set oWb = oExcel.Workbooks.Open(sFilePath, Password:="")
                Set oWb = Workbooks.Open(sFilePath, Password:="")
                On Error GoTo 0
                
                'Openメソッドの結果がNothingであればパスワードの設定ありと判定。
                Dim sWbPwLock  As String
                If oWb Is Nothing Then
                    sWbPwLock = "パスワード設定あり"
                Else
                    sWbPwLock = "パスワード設定なし"
                    
                    Application.DisplayAlerts = False
                    oWb.Close (False)
                    Set oWb = Nothing
                    Application.DisplayAlerts = True
                End If
                
                'チェックの結果を出力
                Debug.Print sWbPwLock & " : " & fFile.Name
            
            End If
            
        End Select
        
    Next
    
    Set oFso = Nothing

End Sub

　■実行結果