Make a created file protected by password

**KLBecker** · 10-10-2023, 03:02 AM

I have searched many forums and have tried many things that I have found but am having no luck. I know that it will likely be something very simple but I cannot figure it out. Would someone please help me adjust the following code, to save the files that are being created as protected files (may be opened and viewed but not edited)? If a message is necessary if someone tries to change values, I would want the message to say only 'changes cannot be made without the appropriate password'. Everything else in my coding works perfectly, would someone please help me? I have cross-posted this to ExcelForum here: https://www.excelforum.com/excel-pro...ml#post5876178

Code:

   For r = FirstRow To sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
        sws.Rows(r).Copy dfCell
        dName = CStr(sws.Cells(r, "A").Value) & NAME_DELIMITER _
            & CStr(sws.Cells(r, "B").Value)
        If Len(dName) > ndLen Then
            dws.Name = dName
            dFilePath = dFolderPath & dName & ".xlsx"
            Application.DisplayAlerts = False
                dwb.SaveAs dFilePath, xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            dCount = dCount + 1
        End If

Thank you so much for your assistance!! I appreciate any help you can offer.

**DocAElstein** · 10-10-2023, 12:50 PM

Hi
Welcome to ExcelFox
I have never looked at any sort of file protection before, but I took a quick initial look, and made some notes here: https://www.excelfox.com/forum/showt...ll=1#post23399
Initially, it seems that to get what you asked for at excelforum and here is fairly simple, at the SaveAs line, which is what Trevor ( TMS ) was suggesting finally in his response at excelforum ( https://www.excelforum.com/excel-pro...ml#post5879059 )

The TooLongDidn'tRead short answer is change this ,
dwb.SaveAs dFilePath, xlOpenXMLWorkbook
, to something like this
dwb.SaveAs dFilePath, xlOpenXMLWorkbook, , "123456"

Don’t forget that extra comma , and keep those arguments in the correct order as shown. Of course, the password is 123456 , in that example. You can use something different. I don’t know what the limits is on what and how many characters you can use.
Alternatively, I personally prefer to use named arguments, because it helps me to remember later what is/ was going on, and the order is then not important. But that is just personal choice. So an alternative would be:
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlOpenXMLWorkbook, WriteResPassword:="123456"

So that it's it. (Check out those extra notes I did for more detail ( https://www.excelfox.com/forum/showt...ll=1#post23399 ) )

I think you mentioned originally that you did not want to make it obvious to people that the file was protected.
I don’t know if that is possible using the built in things. If it isn’t, we still might be able to think of a fiddle to get something close to what you want.

One thing to bear in mind is that file protection in Excel and VBA using the built in ways, is generally regarded as something to prevent people accidentally changing things. It is usually very easy to remove the protection or hack the password if you have very basic VBA knowledge and skills. And even if you are a beginner, you can usually find some information on the internet to give you clear instructions on how to get over the protection.

Alan

Ref
https://www.thespreadsheetguru.com/p...rotection-vba/
https://www.excelforum.com/excel-pro...-password.html
https://www.excelfox.com/forum/showt...ll=1#post23399
https://www.excelfox.com/forum/showt...3400#post23400
https://www.youtube.com/channel/UCnx...RbjOo_MO54oaHA
http://www.vbaexpress.com/forum/show...-upon-start-up

**edwardsjethro** · 03-21-2024, 09:37 AM

To save the files as protected files and display a message when someone tries to make changes without the appropriate password, you can use the following adjusted code:

Code:

For r = FirstRow To sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    sws.Rows(r).Copy dfCell
    dName = CStr(sws.Cells(r, "A").Value) & NAME_DELIMITER _
        & CStr(sws.Cells(r, "B").Value)
    If Len(dName) > ndLen Then
        dws.Name = dName
        dFilePath = dFolderPath & dName & ".xlsx"
        Application.DisplayAlerts = False
            dwb.SaveAs dFilePath, xlOpenXMLWorkbook
        Application.DisplayAlerts = True
        
        ' Protect the workbook
        Dim wb As Workbook
        Set wb = Workbooks.Open(dFilePath)
        wb.Protect Password:="YourPassword", Structure:=True, Windows:=False
        
        ' Add a message to prevent unauthorized changes
        wb.ShowPivotTableFieldList = False ' This line is optional, it hides the PivotTable Field List
        wb.CustomViews.Add ViewName:="ProtectedView"
        MsgBox "Changes cannot be made without the appropriate password.", vbInformation, "Protected File"
        
        dCount = dCount + 1
    End If
Next r