Protect Sheets in Folder with Sub-Folders

[Terry Echols]

It was suggested that I post a new topic as I was asking in others not completely related to what I need to accomplish.

I am not very good with VBA, I guess I know enough to get into trouble with it, but not enough to write code from scratch.

My setup is this:

Files are in folders by year and month

Example:
Folder: 2017 Service Calls
Sub-folders: January 2017 (and all the way through the year for every year)
Files: Monday, January 4, 2017.xlsm (all of my daily files are built off of a template and the naming convention is the same through, if that matters)

So I have the same setup for 2013-2017 (all naming conventions are the same year to year)

I want to lock/protect sheet from editing all the files in each sub-solder (monthly) contained in the Main year folder.

So basically I have almost 365 files each in 12 sub-folders then in a main folder by year.

Please help. I don't want to have to - open/protect sheet on 1000's of files, I have main folders going back to 2013.

Each spreadsheet file is built off of the same template and each workbook has two worksheets (one is called "CALLS" and the other is called "DD-INFO" - the DD-INFO file is password protected and hidden and is used for drop-down information on the CALLS sheet).

If I do this manually I open the file, right click on the CALLS sheet and select "Protect Sheet", I make no changes to the options in the pop-up window, (boxes checked are "Protect worksheet and contents of locked cells" then "Select locked cells" and "Select unlocked cells"). I do not add a password.

To recap:
One folder for each year
One folder for each month in the year
An excel workbook for everyday in the month (M-F) that we are open.

How can I loop through all the year folders then the month folders and then lock/protect sheet from editing each daily excel file? I have searched and searched but can't find anything (code) that does what I need that I have the expertise to edit.

I need to Protect them from editing but I don't want to use a password when opening. Basically these will be search files only that nobody can edit.

I sure don't relish the idea of do this manually for 1000's of files.

Any help is greatly appreciated.

Terry

 

[Fennek]

Re: Protect Seets in Folder with Sub-Folders

Hi,

google for "FSO", i.e. "FileSystemObject"

Three loops
for each f1 in folders
for each f2 in f1.subfolder
for each f in f2.files

regards

 

[AlphaFrog]

Re: Protect Seets in Folder with Sub-Folders

Try this. Change the root path for all the yearly folders to suit.
The code loops through years 2013 to 2017

[COLOR=darkblue]Sub[/COLOR] Accounts_Pricing()
    [COLOR=darkblue]Dim[/COLOR] FSO [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR], fsoFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR], fsoSubfolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] yr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
    strPath = [COLOR=#ff0000]"C:\Test\"[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")
    
    [COLOR=darkblue]For[/COLOR] yr = 2013 [COLOR=darkblue]To[/COLOR] 2017    [COLOR=green]'Years[/COLOR]
        [COLOR=green]'Loop through each monthly subfolder in year folder (yr & " Service Calls")[/COLOR]
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] fsoSubfolder [COLOR=darkblue]In[/COLOR] FSO.GetFolder(strPath & yr & " Service Calls").Subfolders
            [COLOR=green]'Loop through each file in monthly subfolders[/COLOR]
            [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] fsoFile [COLOR=darkblue]In[/COLOR] fsoSubfolder.Files
                [COLOR=darkblue]If[/COLOR] LCase(fsoFile.Name) [COLOR=darkblue]Like[/COLOR] "*" & yr & ".xlsm" [COLOR=darkblue]Then[/COLOR]
                    [COLOR=green]'Open workbook[/COLOR]
                    [COLOR=darkblue]With[/COLOR] Workbooks.Open(Filename:=fsoFile.Path)
                        [COLOR=green]'Protect sheet CALLS[/COLOR]
                        [COLOR=darkblue]With[/COLOR] .Worksheets("CALLS")
                            .Protect Password:=""
                            .EnableSelection = xlNoRestrictions
                        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                        [COLOR=green]'Save and Close Workbook[/COLOR]
                        .Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
                        counter = counter + 1
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]Next[/COLOR] fsoFile
        [COLOR=darkblue]Next[/COLOR] fsoSubfolder
    [COLOR=darkblue]Next[/COLOR] yr
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]Set[/COLOR] FSO = [COLOR=darkblue]Nothing[/COLOR]
    
    MsgBox counter & " files protected.", , "Process Complete"
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Terry Echols]

Re: Protect Seets in Folder with Sub-Folders

Sorry for the delay, got sick.

I have ran this now a few times and it always fails about 20 min. in with "Run-Time Error '1004', Application-defined or object-defined error.

I can't figure out what is causing the error or which file (maybe).

I am trying this on a temp folder, just in case, that I created with only 2016 & 2017 files and I'm running this over the Homegroup network. I changed the path to this new folder ("\\SERVICE\Users\Patrece\Documents\Service Calls - SEARCH ONLY - Copy")

I don't know where or why it's throwing this error.

Any advice? Troubleshooting tips?

Terry

 

[GTO]

Re: Protect Seets in Folder with Sub-Folders

FWIW, I would try:

Put a Debug.Print in to maybe catch what file is hanging up, like:

Debug.Print fsoFile.Path
With Workbooks.Open(Filename:=fsoFile.Path)

It may be successfully opening the workbook, but someone may have typed an errant space in "CALLS", like " CALLS" or "CALLS ".

Also, as you are working on macro-enabled workbooks, I'd disable events whilst opening them.

    Application.EnableEvents = False
    For yr = 2013 To 2017    'Years
        '...code...
    Next yr
    Application.EnableEvents = True

Hope that helps,

Mark

 

[AlphaFrog]

Re: Protect Seets in Folder with Sub-Folders

Sorry for the delay, got sick.

I have ran this now a few times and it always fails about 20 min. in with "Run-Time Error '1004', Application-defined or object-defined error.

I can't figure out what is causing the error or which file (maybe).

I am trying this on a temp folder, just in case, that I created with only 2016 & 2017 files and I'm running this over the Homegroup network. I changed the path to this new folder ("\\SERVICE\Users\Patrece\Documents\Service Calls - SEARCH ONLY - Copy")

I don't know where or why it's throwing this error.

Any advice? Troubleshooting tips?

Terry

I suspect that at least one workbook doesn't have a CALLS sheet. The code below tests if each opened workbook has a sheet named CALLS. If one doesn't, it will just close that workbook and list the file name(s) in the VBA Immediate (Ctrl+G) window.

[COLOR=darkblue]Sub[/COLOR] Accounts_Pricing()
    [COLOR=darkblue]Dim[/COLOR] FSO [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR], fsoFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR], fsoSubfolder [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] yr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], counter [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], counterNoCalls [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
    strPath = "C:\Test\"
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    [COLOR=darkblue]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")
    
    [COLOR=darkblue]For[/COLOR] yr = 2013 [COLOR=darkblue]To[/COLOR] 2017    [COLOR=green]'Years[/COLOR]
        [COLOR=green]'Loop through each monthly subfolder in year folder (yr & " Service Calls")[/COLOR]
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] fsoSubfolder [COLOR=darkblue]In[/COLOR] FSO.GetFolder(strPath & yr & " Service Calls").Subfolders
            [COLOR=green]'Loop through each file in monthly subfolders[/COLOR]
            [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] fsoFile [COLOR=darkblue]In[/COLOR] fsoSubfolder.Files
                [COLOR=darkblue]If[/COLOR] LCase(fsoFile.Name) [COLOR=darkblue]Like[/COLOR] "*" & yr & ".xlsm" [COLOR=darkblue]Then[/COLOR]
                    [COLOR=green]'Open workbook[/COLOR]
                    [COLOR=darkblue]With[/COLOR] Workbooks.Open(Filename:=fsoFile.Path)
                        [COLOR=darkblue]If[/COLOR] IsSheet("CALLS", ActiveWorkbook) [COLOR=darkblue]Then[/COLOR]
                            [COLOR=green]'Protect sheet CALLS[/COLOR]
                            [COLOR=darkblue]With[/COLOR] .Worksheets("CALLS")
                                .Protect Password:=""
                                .EnableSelection = xlNoRestrictions
                                counter = counter + 1
                                [COLOR=green]'Save and Close Workbook[/COLOR]
                                .Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
                            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                        [COLOR=darkblue]Else[/COLOR]
                            [COLOR=green]'Missing CALLS sheet[/COLOR]
                            Debug.Print "No 'CALLS' Sheet: " & fsoFile.Name
                            counterNoCalls = counterNoCalls + 1
                            .Close SaveChanges:=[COLOR=darkblue]False[/COLOR]
                        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]Next[/COLOR] fsoFile
        [COLOR=darkblue]Next[/COLOR] fsoSubfolder
    [COLOR=darkblue]Next[/COLOR] yr
    
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    [COLOR=darkblue]Set[/COLOR] FSO = [COLOR=darkblue]Nothing[/COLOR]
    
    MsgBox counter & " files protected.", , "Process Complete"
    
    [COLOR=darkblue]If[/COLOR] counterNoCalls > 0 [COLOR=darkblue]Then[/COLOR] MsgBox counterNoCalls & " files were opened that didn't have a 'Calls' sheet." & vbLf & _
                                      "Check the 'Immediate Window' in VBA for a list of files.", vbExclamation, "Invalid Files"
    
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
[COLOR=darkblue]Function[/COLOR] IsSheet(strName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], wb [COLOR=darkblue]As[/COLOR] Workbook) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
    IsSheet = strName = wb.Sheets(strName).Name
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]

 

[Terry Echols]

Re: Protect Seets in Folder with Sub-Folders

Thanks guys. I'll test and let you know.

Terry E