Password-protect excel files in folder

Hi,

I'm hoping someone can help. I'm trying to build a quick tool that displays a list of all Excel files from a given folder and then password-protect each one.

So far, I've managed to do this:

1) Look for all Excel files in a given folder and display their names in Column B (i.e. from Cell B9 down).
2) Generate a password in Column C (i.e. from Cell C9 down) automatically based on the filename - I've built this in to the macro I built in step 1.


And now I've hit a snag. I now want to loop through each file from the list in Column B (from B9 down) and assign the corresponding password to it from Column C (from C9 down). I wrote the following code for it, but it doesn't seem to work:

==============================================

Sub ProtectExcelFiles()

    Dim Wbk As Workbook
    Dim Ws1 As Worksheet
    Dim FilenameCell As Range
    Dim PasswordCell As Range
    Dim Lastrow As Integer
    Dim xlFile As String
    Dim usrPassword As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set Ws1 = Sheets("PasswordProtector")
    Lastrow = Ws1.Cells(Rows.Count, 1).End(xlUp).Row

    For Each FilenameCell In Ws1.Range("B9:B" & Lastrow)

        xlFile = FilenameCell.Value
        PasswordCell = Cells(FilenameCell.Column + 1, FilenameCell.Row)
        
        usrPassword = PasswordCell.Value
                
        Set Wbk = Workbooks.Open(xlFile)
        Wbk.ReadOnlyRecommended = False
        Application.DisplayAlerts = False
        Wbk.SaveAs xlFile, WriteResPassword:=usrPassword
        Application.DisplayAlerts = True
        Wbk.Close False

    Next
        
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

==============================================


Any ideas??


Thanks in advance!