Макрос предназначен для замены паролей на открытие, для большого количества файлов Excel.

В качестве исходных данных, задаётся старый и новый пароли.

Если поле «старый пароль» - пустое, подразумевается, что у файлов нет пароля.
Если поле «новый пароль» - пустое, подразумевается, что с файлов снимается пароль.

Нажимаем кнопку, - появляется диалоговое окно выбора папки, - после чего макрос в цикле открывает всё файлы,
и пересохраняет их с новым паролем.

Возможно, у некоторых файлов не получится изменить пароль
(например, у тех, где пароль на открытие отличается от заданного в поле «Старый пароль»)
Список таких файлов программа выводит в таблицу, в виде гиперссылок.

ВНИМАНИЕ: Это очень опасный макрос, - если вы случайно забудете, какой пароль вы установили на файлы,
- все обработанные макросом файлы Excel станут недоступны!

Так что, пользуйтесь макросом на свой страх и риск.

Напоминаю: снять (сбросить) пароль н а открытие файла невозможно!
(только полным перебором, - а это очень долго)

Часть кода макроса: (см. прикреплённый файл)

Sub ChangePasswords()

    On Error Resume Next

    PassOld$ = shs.Range("PassOld").Text

    PassNew$ = shs.Range("PassNew").Text

    folder$ = GetFolder(777, True)        ' запрашиваем имя папки

    If folder$ = "" Then Exit Sub        ' выход, если пользователь отказался от выбора папки

    Dim coll As Collection

    ' считываем в колекцию coll имена файлов XLS*

    Set coll = FilenamesCollection(folder$, "*.xls*")

    If coll.Count = 0 Then

        MsgBox "В выбранной папке не найдено ни одного файла Excel", vbExclamation

        Exit Sub

    End If

    Dim WB As Workbook, nOK&, nErr&

    ' очистка таблицы ошибок

    Intersect(shs.UsedRange, shs.Range("b11:b" & shs.Rows.Count)).ClearContents

    Application.ScreenUpdating = False        ' отключаем обновление экрана

    For Each Filename In coll        ' перебираем найденные в папке файлы

        Err.Clear: Set WB = Nothing

        Set WB = Workbooks.Open(Filename, , , , PassOld$)        ' пробуем открыть очередной файл

        If Not WB Is Nothing Then        ' если файл открылся

            WB.Password = PassNew$        ' ставим новый пароль

            WB.Close True        ' закрываем файл с сохранением изменений

            nOK& = nOK& - (Err = 0)        ' считаем количество успешно сохранённых файлов

        Else        ' файл не открылся - выводим в список ошибок

            nErr& = nErr& + 1

            With shs.Range("b" & 10 + nErr&)

                .Value = Filename

                .Hyperlinks.Add .Resize(, 1), Filename, "", "Попробовать открыть файл вручную"

            End With

        End If

        DoEvents

    Next

    Application.ScreenUpdating = True

    msg$ = "Найдено файлов в папке: " & coll.Count & vbNewLine & _

           "Удалось заменить пароли на файлах: " & nOK&

    MsgBox msg, vbInformation, "Готово"

End Sub