Want to change password on multiple workbooks

[Crugers]

I need to give access to all my Excel 2003 workbooks (100's of files and my job is surplus to requirements). I always used one of two passwords on all workbooks for both file Open and WriteRes. However I don't want to give my passwords (which would be the simplist solution).
What I would like to do is use VBA to open each workbook using my password(s), then change both Open and WriteRes password(s), then save as same filename overwriting the original file.

My biggest problem is I'm a beginner at VBA and while I 'get' somethings to work I know I don't always understand how or why it works!

I have searched and found a macro the extracts a list of filenames as text and puts them in column A of Sheet named "Files"

Public Sub Auto_Open() 
Dim j As Integer
Dim i As Long
Sheets("Files").Columns("A:A").ClearContents
With Application.FileSearch
.LookIn = "C:\TestBed\TestExtractFileNames"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.Execute
j = 1
For i = 1 To .FoundFiles.Count
ActiveWorkbook.Worksheets("Files").Cells(j, 1) = .FoundFiles(i)
j = j + 1
Next i
End With
End Sub

By running the code below I can open a hard coded named file using most used password first, if it fails then second password, then resaving the file with a new password overwriting the original file.
But I don't know and can't find how to use the original list of file names starting at row 1 and incrementing to row 2 etc in place of the hard coded filename.

Sub OpenPasswordProtectedFile()
Screenupdate = False 'Stops screen updating & speed up macro
On Error Resume Next 'If file password #1 is incorrect, this moves macro onto next line to open with password #2 without flagging error and requesting input.
Workbooks.Open Filename:="C:\TestBed\TestExtractFileNames\XXX.xls", UpdateLinks:=2, Password:="abc", WriteResPassword:="abc" 'Opens listed Excel workbook without updating links with password "abc" to both open and write.
Workbooks.Open Filename:="C:\TestBed\TestExtractFileNames\XXX.xls", UpdateLinks:=2, Password:="def", WriteResPassword:="def" 'Opens listed Excel workbook without updating links with password "def" to both open and write.
Application.DisplayAlerts = False 'Stops Excel requesting confirmation to replace existing file of same name.
ActiveWorkbook.SaveAs Filename:="C:\TestBed\TestExtractFileNames\XXX.xls", Password:="xyz", WriteResPassword:="xyz" 'Re-saves listed Excel workbook with password "xyz" to both open and write.
ActiveWorkbook.Close 'Closes file
End Sub

I suspect that I'm going the long way round making the list of filenames first and then using it to open the file (I mean if I'm capturing the filename as text in the first piece of code, I should be able to open the file at that point, change the password, and resave it overwriting the file). I also suspect I'm a little short of 'error trapping' in case I come across file(s) that have neither password 'abc' or 'def'... <?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
Any and all help welcome and appreciated!<o></o>
p.s. 'abc', 'def' and 'xyz' are not my real passwords!

 

[Datsmart]

I combined your two processes and put in some error checking.
It works in some test files I setup.

Sub OpenPasswordProtectedFile()
Dim i As Long

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\TestBed\TestExtractFileNames"
    .FileType = msoFileTypeExcelWorkbooks
    .SearchSubFolders = True
    .Execute
    For i = 1 To .FoundFiles.Count
        'Assign FileName variable
        fn = .FoundFiles(i)
        Application.ScreenUpdating = False 'Stops screen updating & speed up macro
        On Error Resume Next 'If file password #1 is incorrect, this moves macro onto next line to open with password #2 without flagging error and requesting input.
        'Opens listed Excel workbook without updating links with password "abc" to both open and write.
        Workbooks.Open Filename:=fn, UpdateLinks:=2, Password:="abc", WriteResPassword:="abc"
        'Check to see if first password worked, if it did, second try will close first
        Path1 = ActiveWorkbook.Path & "\"
        If Path1 & ActiveWorkbook.Name <> fn Then
            'Opens listed Excel workbook without updating links with password "def" to both open and write.
            Workbooks.Open Filename:=fn, UpdateLinks:=2, Password:="def", WriteResPassword:="def"
        End If
        'Check to see if Second password worked, if not, Message and move to Nexti
        Path1 = ActiveWorkbook.Path & "\"
        If Path1 & ActiveWorkbook.Name <> fn Then
            MsgBox "         Unable to open file" & vbCrLf _
            & fn, , "Password Attempt Failed"
            'Reset Alerts and Updating
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
            GoTo Nexti
        End If
        'Stops Excel requesting confirmation to replace existing file of same name.
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=fn, Password:="xyz", WriteResPassword:="xyz"
        'Close file
        ActiveWorkbook.Close
Nexti:
    Next i
End With
    'Reset Alerts and Updating
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Crugers]

Thanks John
I'll update the thread once I use it tomorrow.

 

[Crugers]

Thanks again John
Worked a treat!