VB Code Password Protect Multiple excel files

Hello:

Small change.
Code can first Unprotect all excel files with password "ABCD"
and then ask if user wants to protect all files with the new password.

Please let me know if you have any questions.
Thanks.

Riz

Hello Guys:

I have worked on this and come up with some coding but need help to complete.
Please refer to attached file with the associated VB code.

Let me know if you have any questions.
Thanks.

Hi Riz,
try:

Sub test()

    Dim c As Range, rng As Range
    Dim sFolder As String, sSourceFile As String
    Dim sPW As String, sNewPW As String
    Dim wb As Workbook

    sFolder = "C:\Temp\"    'folder where the files are
    sPW = "ABCD"    'current password
    sNewPW = "1234"    'new password to be set

    On Error Resume Next
    Set rng = ThisWorkbook.Sheets("Sheet1").Columns("B").SpecialCells(2, 2)    'all constant textvalues in column B
    On Error GoTo 0

    For Each c In rng.Cells
        sSourceFile = sFolder & c.Value
        If Len(Dir$(sSourceFile)) Then
            Set wb = Workbooks.Open(sSourceFile, , , , sPW)
            Application.DisplayAlerts = False
            wb.SaveAs sSourceFile, wb.FileFormat, sNewPW
            wb.Close False
            Application.DisplayAlerts = True
        End If
    Next c

End Sub

See how this works for you.

//berlan

Hi Berlan:

Super Smart...seems to work.
Need some modification.
1st : each file in the folder opens and then close....i want to see if i can avoid opening and closing the file.
2nd : Pick up the new PW for each file from corresponding cell in column C.
Example the file name listed in cell B10 , new password would be in cell C10.

Please let me know if you have any questions.
Thanks.

Riz

Hello berlan:

Ok Thanks now can u add the code to turn off manual, screen updating etc and let me try.
Riz

Sure, adding it here:

Sub test2()

    Dim c As Range, rng As Range
    Dim sFolder As String, sSourceFile As String
    Dim sPW As String
    Dim wb As Workbook

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    sFolder = "C:\Temp\"    'folder where the files are
    sPW = "ABCD"    'current password

    On Error Resume Next
    Set rng = ThisWorkbook.Sheets("Sheet1").Columns("B").SpecialCells(2, 2)    'all constant textvalues in column B
    On Error GoTo 0

    For Each c In rng.Cells
        sSourceFile = sFolder & c.Value
        If Len(Dir$(sSourceFile)) Then
            Set wb = Workbooks.Open(sSourceFile, , , , sPW)    'change sPW to c(, 3).Value for corresponding D column
            wb.SaveAs sSourceFile, wb.FileFormat, c(, 2).Value  'value from C column
            wb.Close False
        End If
    Next c

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub

Hi Berlan:

Seems to work now...and it is not even opening the file.
I thank you so mich for such a great help.
Will test more and let you know if any problem.
Love it.
Riz

Glad to help and thanks for the positive rep.

Hi Berlan:

Would it be possible to add extra code so that it can password protect VB Code module itself also.
If VB Coding in the file is not protected then assign same PW as workbook PW.
If VB Coding in the file is protected then change the PW from original PW to new PW and original PW will be the same as PW for the workbook.

Please let me know if you have any questions.
Thanks.

Riz

Hi rizmomin,

Tricky! There's no easy way to set the VBAProject password by code that I know of. You will need to open the project window for each workbook that you go through, and to do this by code, you need to involve API functions (instead of using SendKeys). I will look into it later in the week.

Meanwhile, perhaps start a separate thread on creating and modifying a VBAProject password, as others may be able to try it out.

//berlan