Есть ли более быстрый способ пакетной защиты файлов?

Question

Есть ли способ отредактировать что-то вроде этого:

Sub password()
Dim wb As Workbook
Dim StrPassword As String, strFile As String, strFolder As String

StrPassword = "xxxxxxx"
strFolder = "C:\"
strFile = Dir(strFolder & "*Report.xlsx", vbNormal)

FastMode True


While strFile <> ""

   Set wb = Workbooks.Open(filename:=strFolder & strFile)

    With wb
        .password = StrPassword
        .SaveAs filename:=wb.FullName, password:=StrPassword
        .Close
    End With
    strFile = Dir()

Wend

FastMode False

End Sub



Public Sub FastMode(ByVal Toggle As Boolean)
    Application.ScreenUpdating = Not Toggle
    Application.EnableEvents = Not Toggle
    Application.DisplayAlerts = Not Toggle
    Application.EnableAnimations = Not Toggle
    Application.DisplayStatusBar = Not Toggle
    Application.PrintCommunication = Not Toggle
    Application.Calculation = IIf(Toggle, xlCalculationManual, xlCalculationAutomatic)
End Sub

Мне было интересно, есть ли способ назначить каталог путей и устранить необходимость открывать-защищать паролем-закрывать каждый файл? Я могу сказать, что этот процесс занимает 99% времени, необходимого для выполнения кода.

Существуют ли способы пакетного добавления пароля, не предпринимая особых действий для отдельного открытия / закрытия файлов?

Требуется около 20 минут, чтобы защитить паролем 2500 файлов, что неплохо, но мне интересно, можно ли это сделать намного быстрее?