Unlock multiple workbooks and each workbook has their own password (VBA)

Question

Sorry guys i have some question about unlock multiple protected workbooks

since i have around more than 200 xlsm workbooks was protected in a folder, let say store in "C:\temp"

i have another workbook(called password.xlsm) store those 200 xlsm workbooks's password in worksheet1, i want to remove all the password of the all xlsm files by macro.

such as

file  password
A     112233
B     225588
C     KKK999
..    ...

and here is my code, i find some vba scripting for reference, but i am a noob

Sub UnEncyptedFile()
Dim oExcel As Excel.Application
Set oExcel = New Excel.Application
Dim oWorkbook As Excel.Workbook
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim Pwcode As String

Dim filename As String
Dim LastRow As Long

Set objFSO = CreateObject("Scripting.FilesyStemObject")
Set objFolder = objFSO.GetFolder("C:\temp")

LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For Each objFile In objFolder.Files
    checkfilename = objFile.Name
    checkfilename = Left(checkfilename, Len(checkfilename) - 5)
       For i = 2 To LastRow
           If ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = checkfilename Then

           Pwcode = ThisWorkbook.Sheets("Sheet1").Cells(i, 2).Value    
           Set oWorkbook = oExcel.Workbooks.Open(objFolder & "\" & objFile.Name, Password:=Pwcode)
           oWorkbook.SaveAs Filename:=objFolder & "\" & objFile.Name, Password:=""
           oWorkbook.Close (True)

           End If
           Exit For
      Next i    
Next objFile
End Sub

if i check the file name is equal to the name i store in "password" this workbook in sheet1 column A then I open the file and save the file to its original path and remove the Password:=""

i success to open the workbook(A.xlsm) but it haven't assign the password automatically so it only open the workbook but i need to input the password by hand.... and then it stops looping

could anyone help me where is the problem?

although i know there is another way can crack the excel without knowing the password, but i dun want to use it. — Nicawong9147

urdearboy urdearboy · Accepted Answer · 2018-10-04T02:15:55

You can try this although I changed the logic. Instead of looping through the folder, I am looping through the excel files stored on your master excel (password.xlsm) in Column A.

Sub Robot()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim Loc As String: Loc = "C:\tempt\"
Dim pw As String, fn As String, cb As Workbook, i As Long

'Loc = Local Location
'pw = Password
'fn = File Name
'cb = Current Book

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        On Error Resume Next 'If book does not exist
            fn = Loc & ws.Range("A" & i)
            pw = ws.Range("B" & i)

            Set cb = Workbooks.Open(fn, Password:= pw)

            cb.SaveAs fn, Password:=""
            cb.Close False 'You just saved the book above, no need for TRUE
        On Error GoTo 0
    Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Unlock multiple workbooks and each workbook has their own password (VBA)

1 Answers