Защищено паролем - PullRequest
Новая
       10

Защищено паролем

0 голосов
/ 05 февраля 2020

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

Проблема 1: большие файлы (например, 90 000 КБ) не могут быть открыты

Проблема 2: потому что файлы связаны друг с другом, когда макрос пытается защитить следующую Файл запрашивает пароль для каждого защищенного связанного файла.

Есть ли способ избежать ввода пароля для каждого файла, связанного в activeworkbook?

Это мой код: 

Private Sub CommandButton1_Click()

Dim Y_N As String
Dim Nrow As Long

Y_N = Application.InputBox("Please state if you want to PROTECT or UNPROTECT the files")

Select Case Y_N
Case "PROTECT"
'Generate random password

Dim CharacterBank As Variant
Dim x As Long
Dim str As String
Dim basicpass(10) As Variant
Dim encrpass(10) As Variant
Dim lrow As Long
Dim newrow As Long

CharacterBank = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
  "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", _
  "y", "z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "!", "@", _
  "#", "$", "%", "^", "&", "*", "A", "B", "C", "D", "E", "F", "G", "H", _
  "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", _
  "W", "X", "Y", "Z")

For x = 1 To 10

    Randomize

    'str = str & CharacterBank(Int((UBound(CharacterBank) - LBound(CharacterBank) + 1) * Rnd + LBound(CharacterBank)))
    pstInBank = Int((UBound(CharacterBank) - LBound(CharacterBank) + 1) * Rnd + LBound(CharacterBank))
    basicpass(x) = CharacterBank(pstInBank)
    'encr(x, 1) = CharacterBank(Int((UBound(CharacterBank) - LBound(CharacterBank) + 1) * Rnd + LBound(CharacterBank)))

    If CharacterBank(pstInBank) = "X" Or CharacterBank(pstInBank) = "Y" Or CharacterBank(pstInBank) = "Z" Then

        encrpass(x) = CharacterBank(pstInBank)
    Else
        encrpass(x) = CharacterBank(pstInBank + 3)
    End If

Next x

RandomString = Join(basicpass, "")
ThisWorkbook.Worksheets("Files").Range("I1") = RandomString

Workbooks.Open Filename:="xxxxx\Password Records.xlsx"

lrow = Workbooks("Password Records.xlsx").Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
newrow = lrow + 1

Workbooks("Password Records.xlsx").Worksheets("Sheet1").Range("A" & newrow) = ThisWorkbook.Worksheets("Files").Range("B1") & " " & ThisWorkbook.Worksheets("Files").Range("B2")
Workbooks("Password Records.xlsx").Worksheets("Sheet1").Range("B" & newrow) = Join(encrpass, "")
Workbooks("Password Records.xlsx").Worksheets("Sheet1").Range("C" & newrow) = Join(basicpass, "")

Workbooks("Password Records.xlsx").Save
Workbooks("Password Records.xlsx").Close

'Protect the files

Dim path As String
Dim masterfile As Workbook

Dim at As Integer
Dim th As Integer
Dim pctCompl As Single

Application.DisplayAlerts = False

Set masterfile = ThisWorkbook

For I = 5 To 20

    masterfile.Activate
    path = Worksheets("Files").Range("B" & I)
    Workbooks.Open Filename:=path
    ActiveWorkbook.SaveAs Filename:=path, password:=RandomString, WriteRespassword:=RandomString
    ActiveWorkbook.Save
    ActiveWorkbook.Close

Next I
...