Пароль, защищающий несколько файлов в каталоге

Question

У меня есть каталог, содержащий 50 файлов .xlsx. Мне нужно отправить их кому-то и из-за ограничений рабочей среды я не могу использовать Winzip.

Я ранее защищал паролем каждый файл .xlsx вручную, но задавался вопросом, есть ли способ автоматизировать, как я могу это сделать? Это связано с тем, что я регулярно обновляю эти файлы (удаляя пароль для удобства), а затем повторно применяя пароль перед отправкой.

Answer 1

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

Option Explicit 

Const FOLDER As String = "C:\Temp\Test xl file bulk pw protection\" 
Const PASSWORD As String = "weakpassword" 
Dim app As Excel.Application 
Dim strFile As String 
Dim wb As Workbook 

Sub Password_ON() 
    Set app = New Excel.Application 
    strFile = Dir(FOLDER) 
    app.DisplayAlerts = False 
    Do While Len(strFile) > 0 
     Set wb = app.Workbooks.Open(FOLDER & strFile) 
     wb.SaveAs wb.FullName, , PASSWORD 
     wb.Close 
     strFile = Dir 
    Loop 
    app.DisplayAlerts = True 
    app.Quit 
    Set app = Nothing 
End Sub 

Sub Password_OFF() 
    Set app = New Excel.Application 
    strFile = Dir(FOLDER) 
    app.DisplayAlerts = False 
    Do While Len(strFile) > 0 
     Set wb = app.Workbooks.Open(FOLDER & strFile, , , , PASSWORD) 
     wb.SaveAs wb.FullName, , vbNullString 
     wb.Close 
     strFile = Dir 
    Loop 
    app.DisplayAlerts = True 
    app.Quit 
    Set app = Nothing 
End Sub 

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

Sub Password_ON() 
    Set app = New Excel.Application 
    strFile = Dir(FOLDER) 
    app.DisplayAlerts = False 
    Do While Len(strFile) > 0 
     Application.StatusBar = "Processing " & strFile 
     DoEvents 
     Set wb = app.Workbooks.Open(FOLDER & strFile) 
     wb.SaveAs wb.FullName, , PASSWORD 
     wb.Close 
     strFile = Dir 
    Loop 
    app.DisplayAlerts = True 
    app.Quit 
    Set app = Nothing 
    Application.StatusBar = "READY" 
End Sub 

Sub Password_OFF() 
    Set app = New Excel.Application 
    strFile = Dir(FOLDER) 
    app.DisplayAlerts = False 
    Do While Len(strFile) > 0 
     Application.StatusBar = "Processing " & strFile 
     DoEvents 
     Set wb = app.Workbooks.Open(FOLDER & strFile, , , , PASSWORD) 
     wb.SaveAs wb.FullName, , vbNullString 
     wb.Close 
     strFile = Dir 
    Loop 
    app.DisplayAlerts = True 
    app.Quit 
    Set app = Nothing 
    Application.StatusBar = "READY" 
End Sub