You Look Too Cool

Sub 複数ファイルパスワード操作()
    Dim myfolder, myfn, myword, pwopen, pwclose
    Dim pattern
    '操作を選択
    pattern = MsgBox("パスワード解除ならば「はい」、セットならば「いいえ」", vbYesNo)
    If pattern = vbCancel Then
        Exit Sub
    End If
    'パスワードをセット
    myword = InputBox("パスワードを入力。")
    If pattern = vbYes Then
        pwopen = myword
        pwclose = ""
    ElseIf pattern = vbNo Then
        pwopen = ""
        pwclose = myword
    End If
    'フォルダを選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "操作したいファイルのあるフォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            myfolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    'ファイルを操作
    myfn = Dir(myfolder & "\*.xls", vbNormal)
    Do Until myfn = ""
        Call ファイル開閉(myfolder & "" & myfn, pwopen, pwclose)
        myfn = Dir
    Loop
End Sub

Function ファイル開閉(myfn, pwopen, pwclose)
    Workbooks.Open Filename:=myfn, Password:=pwopen
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=myfn, Password:=pwclose, WriteResPassword:=""
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
End Function