Снятие защиты с нескольких рабочих книг VBA - PullRequest
Новая
       34

Снятие защиты с нескольких рабочих книг VBA

0 голосов
/ 06 июня 2019

Я пытаюсь разблокировать несколько Excel Workbooks из файла.Я знаю пароль, и он одинаков для всех файлов.

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

Мой ActiveWorkbook.Unprotect не работает сам по себе, и я действительно не понимаю почему, потому что я не видел другой синтаксис в Интернете.

Это мой код: 

Sub Hell3()
    Dim WB As Workbook
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            Workbooks.Open (xFdItem & xFileName), Password:="pass"
            ActiveWorkbook.Unprotect Password:="pass"
            xFileName = Dir
        Loop
    End If

    Dim macrowb As String
    macrowb = "Book1.xlsm"
    For Each WB In Application.Workbooks
        If WB.Name <> macrowb Then
            WB.Close SaveChanges:=True
        End If
    Next WB
End Sub

Ответы [ 2 ]

2 голосов
/ 06 июня 2019

Это будет работать: 

Sub Hell3()
    Dim WB As Workbook
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)

    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        MkDir xFdItem & "\Password Removed Files"
        Do While xFileName <> ""
            Set WB = Workbooks.Open((xFdItem & xFileName), Password:="pass")

                WB.SaveAs Filename:=xFdItem & "Password Removed Files\" & xFileName, FileFormat:=51, Password:="", WriteResPassword:="", _
                ReadOnlyRecommended:=False, CreateBackup:=False

                WB.Close True

            xFileName = Dir
        Loop
    End If


End Sub

Создать новую папку с паролем удаленных файлов

2 голосов
/ 06 июня 2019

Использование ActiveWorkbook часто может привести к проблемам.Вот почему общий совет - избегать этого и вместо этого обращаться к каждой книге в явном виде.Вы предполагаете, что когда рабочая книга открыта, она становится активной.

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

Попробуйте это: 

Do While xFileName <> ""
    Set wb = Workbooks.Open(xFdItem & xFileName, Password:="pass")
    wb.Unprotect Password:="pass" ' This explicitly unprotects the opened workbook.
    xFileName = Dir
    wb.SaveAs Filename:=xFdItem & xFileName, FileFormat:=xlOpenXMLStrictWorkbook, Password:=""
Loop

Дополнительная информация: https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.saveas

...