[решено] Перебор Xls В папке, с архивированием каждого файла разным паролем

fawor1t · Отправлено: **13:46, 13-07-2017** | #5

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

Код:

Dim sFolder
Dim Ofile

Sub Workbook_Open()
   sFolder = "С:\01\xls\"

Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each Ofile In oFSO.GetFolder(sFolder).Files
  If UCase(oFSO.GetExtensionName(Ofile.Name)) = "XLS" Then
    ProcessFiles oFSO, Ofile
  End If
  
Next

Set oFSO = Nothing

End Sub
Sub ProcessFiles(FSO, File)

Dim excel

Workbooks.Open Filename:=Ofile
excel = ActiveCell.Cells(11, 1).Value

ActiveWorkbook.Close

Windows("start.xlsm").Activate
    Sheets("Пароли").Select
a = Range("A1:B10").Find(excel).Row
b = Range("A1:B10").Find(excel).Column


pass = Sheets("Пароли").Cells(a, b + 1).Value
mail = Sheets("Пароли").Cells(a, b + 2).Value

FolderName = "С:\01\zip\"
PathZipProgram = "C:\Program Files\7-Zip\"
smail = FolderName + mail + ".zip"

ShellStr = PathZipProgram & "7z.exe a -tzip -p" & pass & "" & " " & smail & " " & Ofile & ""

Shell ShellStr




End Sub