CODEWITHSUNDEEP
excelvbapassword-protection
clara
clara

Reputation: 45

Unprotecting multiple workbooks VBA

I am trying to unlock multiple Excel Workbooks from within a file. I know the password and it's the same for all files.

I run the following code. It works in the sense that I don't get an error message and that all the right workbooks are opened and then closed. However when I try opening the files manually after running the code I am still asked for a password.

My ActiveWorkbook.Unprotect doesn't work on its own and I really don't understand why because I haven't seen a different syntax across the internet.

This is my code:

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

Upvotes: 0

Views: 2425

Answers (2)

Mikku
Mikku

Reputation: 6664

This will Work:

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

Will Create a New Folder with the Password Removed Files

Upvotes: 1

Chris Melville
Chris Melville

Reputation: 1518

Using ActiveWorkbook can often to lead to problems. That's why the general advice is to avoid it, and instead refer to each workbook explicitly. You're assuming that when a workbook is opened, it is made the Active one.

Edit: since you have now clarified that it's the file protection you want to remove (not the Workbook protection), you need to use SaveAs, and remove the password protection from the file - as below

Try this:

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

More information: https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.saveas

Upvotes: 2

Related Questions