【VBA】ファイルを開く【読み取り専用やパスワード付きファイル】

'ファイルパスを指定
A = ThisWorkbook.Path & "\TEST.xlsx"
Workbooks.Open FileName:=A, ReadOnly:=True '読み取り専用で開く
Workbooks.Open FileName:=A, Password:=123 'パスワード付きファイルを開く

Sub TEST1()
    
    Dim A
    'ファイルパスを指定
    A = ThisWorkbook.Path & "\TEST.xlsx"
    
    'ファイルを開く
    Workbooks.Open FileName:=A
    
End Sub

Sub TEST2()
    
    Dim A
    'ファイルパスを指定
    A = ThisWorkbook.Path & "\TEST.xlsx"
    
    '読み取り専用で開く
    Workbooks.Open FileName:=A, ReadOnly:=True
    
End Sub

Sub TEST3()
    
    Dim A
    'ファイルパスを開く
    A = ThisWorkbook.Path & "\TEST.xlsx"
    
    'パスワード付きファイルを開く
    Workbooks.Open FileName:=A, Password:=123
    
End Sub

Sub TEST4()
    
    Dim A
    'ファイルパスを指定
    A = ThisWorkbook.Path & "\TEST.xlsx"
    
    'パスワード付きファイルを開く
    Workbooks.Open FileName:=A, Password:=123
    
    Application.DisplayAlerts = False 'メッセージを非表示
    'パスワードを削除して保存
    ActiveWorkbook.SaveAs Filename:=A, Password:=""
    Application.DisplayAlerts = True 'メッセージを非表
    
    'ファイルを閉じる
    ActiveWorkbook.Close
    
End Sub

Sub TEST5()
    
    Dim A
    'ファイルパスを指定
    A = ThisWorkbook.Path & "\TEST.xlsx"
    
    'ファイルを開く
    Workbooks.Open FileName:=A
    
    Application.DisplayAlerts = False 'メッセージを非表示
    'パスワードを設定して保存
    ActiveWorkbook.SaveAs Filename:=A, Password:=123
    Application.DisplayAlerts = True 'メッセージを非表
    
    'ファイルを閉じる
    ActiveWorkbook.Close
    
End Sub

Public ChrData 'Shift-Jisコードを保存
Public PassArray 'パスワードを一時保存
Public FilePath 'パスワード付きファイルのフルパス
Public flag_End '探索をとめるフラグ

'パスワードを解析する
Sub Analyze_Password()
    
    Dim Lo
    Lo = 3 '桁数
    
    FilePath = ThisWorkbook.Path & "\TEST.xlsx" 'パスワードを解除するエクセルファイルのパス
    ReDim PassArray(0 To Lo - 1) As Variant 'パスワードを格納
    flag_End = 0 'ループを止めるフラグ
    
    'パスワード検索用の文字を取得
    ReDim ChrData(1 To 10) As Variant
    m = 0
    For i = 0 To 9
        m = m + 1
        ChrData(m) = i '0～9の数字
    Next
    
    Call OpenFile(Lo) 'パスワードを作成してエクセルファイルを開く
    
End Sub


'ファイルを開く
Sub OpenFile(ByVal Lo As Variant)
    
    Lo = Lo - 1
    
    '桁数だけループ
    If Lo >= 0 Then
        '文字数だけループ
        For i = 1 To UBound(ChrData)
            
            'パスワード作成
            PassArray(Lo) = ChrData(i) '1文字を更新
            Pass = Join(PassArray, "") '文字列を結合
            
            'ファイルを開けたら終了
            If flag_End = 1 Then Exit Sub
            
            'ファイルを開く
            On Error Resume Next
            Workbooks.Open FileName:=FilePath, Password:=Pass
            If Err.Number = 0 Then 'エラーの場合1004 エラーなし0
                flag_End = 1 'パスワード解析をストップ
                MsgBox "開けました。パスワードは " & Pass & " です"
                Exit Sub
            End If
            
            '再帰する
            Call OpenFile(Lo)
        Next
    End If

End Sub