Using code and apply to other spreadsheet?

[bsnapool]

I have the following code which meets my requirments for individual spreadsheets....

Sub Unprotect52() 
Dim ws As Worksheet 

    For I = 1 To 52 
        Set ws = Worksheets(CStr(I)) 
        With ws 
            .Unprotect "liverpool" 
            .Cells.ClearContents 
            .Protect "liverpool" 
            .Tab.ColorIndex = -4142 
        End With 
    Next I 

End Sub

I have 75 spreadsheets which are the same, in the same directory/folder. Is there any way I could run this code and this would run on all 75 spreadsheets?

Note, 75 spreadsheets have passwords on them, but I have a full list of team names and passwords.

Any help would be much appreciated.

Thanks

Andrew

 

[Von Pookie]

You could use code to open each workbook in the folder:
http://www.mrexcel.com/board2/viewtopic.php?t=137379

 

[bsnapool]

Thanks Kristy

I have code which looks at passwords and file names, were in the code suggested would you recommend I add this?

Andrew

 

[Von Pookie]

Is the list of file names/passwords in a workbook? I'm just trying to get an idea of what your setup is. Filename in col A, password in Col B, for example?

 

[bsnapool]

Is the list of file names/passwords in a workbook? I'm just trying to get an idea of what your setup is. Filename in col A, password in Col B, for example?

Exactly right. The code I have below is in sheet1 and the passwords are in a sheet called. "passwords"

Here is the code I have put together so far from bits of code. I think i am going wrong at the end as it seems to loop and does not to do anythin:

Sub Hello()
Dim Bk As Workbook
Dim WS As Worksheet
Dim V As Variant
Dim sPassword As String
Dim wsSumm As Worksheet, wsPWD As Worksheet

With Application.FileSearch
    .NewSearch
    .LookIn = "S:\DHSC S&A\test"
    .SearchSubFolders = False
    .Filename = "*.xls"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
End With
V = "*"
        On Error Resume Next
        V = WorksheetFunction.Match(Filenm, wsPWD.Columns("A"), 0)
        On Error GoTo 0
        If IsNumeric(V) Then
            sPassword = wsPWD.Cells(V, "B").Text
        Else
            sPassword = ""
        End If
        On Error Resume Next
        Workbooks.Open Filename:=Folderpath & "\" & Filenm, _
                        ReadOnly:=True, _
                        Password:=sPassword
        lErrNum = Err.Number
    For I = 1 To 52
        Set WS = Worksheets(CStr(I))
        With WS
            .Unprotect "liverpool"
            .Cells.ClearContents
            .Protect "liverpool"
            .Tab.ColorIndex = -4142
End With
Next
a1.Select
    
End Sub

Any ideas??

Thanks

Andrew

 

[Von Pookie]

You have the search part but it looks like you've left out the bit that actually loops through the files

This is completely and utterly untested, but may give you some idea of what could be done:

Sub Hello()
Dim Bk As Workbook, WS As Worksheet
Dim wsSumm As Worksheet, wsPWD As Worksheet
Dim sPassword As String, Filenm As String, temp As String
Dim i As Long, x As Integer, ans As Variant, V As Range

' the worksheet with the passwords, set to variable
Set wsPWD = ThisWorkbook.Sheets("Passwords")

With Application.FileSearch ' this part searches the directory
    .NewSearch
    .LookIn = "S:\DHSC S&A\test\"
    .SearchSubFolders = False
    .Filename = "*.xls"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles

    If .Execute() > 0 Then
        ' this is what loops through the files found in the directory
        For i = 1 To .FoundFiles.Count

            'this returns the full path of the file
            Filenm = .FoundFiles(i)

            'returns filename.xls from full path
            For x = Len(Filenm) To 1 Step -1
                If Mid(Filenm, x, 1) = Application.PathSeparator Then Exit For
                temp = Mid(Filenm, x, 1) & temp
            Next x
            Filenm = temp

            ' removes .xls from end of filename
            ' CAN REMOVE THIS IF NOT NEEDED--I'm not sure how the
            ' filenames are listed in the column
            Filenm = Replace(Filenm, ".xls", "")

            'search THIS workbook for the filename/password
            With wsPWD
                'search column A for the filename
                Set V = .Columns(1).Find(Filenm)

                If Not V Is Nothing Then 'if the filename is found
                    'set the password from column B
                    sPassword = V.Offset(, 1).Text
                Else 'if the filename is not found
                    ans = MsgBox("Filename not found in password list!" & String(2, vbCrLf) _
                    & "Skip workbook "" & Filenm & "" and continue running macro?", vbYesNo + vbExclamation)

                    ' if 'yes' (skip workbook and continue), jump to the end
                    ' of the loop (marked with label of '10') and continue looping through files
                    If ans = vbYes Then GoTo 10
                    
                    ' if 'no' (do not continue), end macro
                    If ans = vbNo Then End
                End If
            End With

            'if filename/password was found, code continues here

            'open the workbook, sets to variable Bk
            Set Bk = Workbooks.Open(Filename:=.FoundFiles(i), _
            ReadOnly:=True, Password:=sPassword)

            'loop through the sheets in the workbook
            With Bk
                For Each WS In .Worksheets
                    With WS
                        .Unprotect sPassword
                        .Cells.ClearContents
                        .Protect sPassword
                        .Tab.ColorIndex = -4142
                    End With
                Next WS
                .Save 'save the workbook
                .Close 'close the workbook
            End With

10: ' label to jump to if password not found--code continues from this point

        Next i ' loop to the next file
    Else
        MsgBox "There were no .xls files found in the specified directory.", vbCritical, "Error 101"
    End If
End With

End Sub

 

[bsnapool]

Kristy

I have made a few amendments and I think i am nearly there... Just 2 things which need to ask:

1) The code below should only clear contents from tabs 1 to 52

With Bk
                For Each WS In .Worksheets
                    With WS
                        .Unprotect "liverpool"
                        .Cells.ClearContents
                        .Protect "liverpool"
                        .Tab.ColorIndex = -4142
                    End With
                Next WS
                .Save 'save the workbook
                .Close 'close the workbook
            End With

2) I think the password match code is now working as this works for the first file but then comes up with your error message you have added:

  Else 'if the filename is not found
                    ans = MsgBox("Filename not found in password list!" & String(2, vbCrLf) _
                    & "Skip workbook "" & Filenm & "" and continue running macro?", vbYesNo + vbExclamation)

I have double checked the names of the workbooks and the passwords are all correct.

Any ideas?

Thanks for your help (Once again)

Andrew

 

[Von Pookie]

1) The code below should only clear contents from tabs 1 to 52

Oop. My fault. That's easy to fix, though. You basically do what you were doing in your original code, but you shouldn't need the CStr bit. Try:

With Bk
                For x = 1 to 52
                    With .Sheets(x)
                        .Unprotect "liverpool"
                        .Cells.ClearContents
                        .Protect "liverpool"
                        .Tab.ColorIndex = -4142
                    End With
                Next x
                .Save 'save the workbook
                .Close 'close the workbook
            End With

2) I think the password match code is now working as this works for the first file but then comes up with your error message you have added:

  Else 'if the filename is not found
                    ans = MsgBox("Filename not found in password list!" & String(2, vbCrLf) _
                    & "Skip workbook "" & Filenm & "" and continue running macro?", vbYesNo + vbExclamation)

I have double checked the names of the workbooks and the passwords are all correct.
Andrew

Did you check what the value of Filenm was at the time? That would be the current file it is looking for. For example, if you have the file containing the passwords in the same folder as all of those other files, it will be included in the loop as well. I'm assuming said password file would not be included in the password list, correct? If it can't find that filename in the list...

That's just one possible scenario, though. I just realized I forgot to add a check for that. That would be just a simple if statement, though. The easiest way to do it would probably be to just add this line:

If Filenm = ThisWorkbook.Name Then GoTo 10

Add this in the code BEFORE the statement with the "CAN REMOVE THIS IF NOT NEEDED" comment.

 

[bsnapool]

Kristy

Thanks for your quick reply.. I shall make the amendments when at work tomorrow and let you know how it went...

Thanks again

Andrew

 

[Von Pookie]

OH! I just had a moment to work up some sample files to test the code. I ran into it causing an error on the second file as well. Know why? I forgot to clear the "temp" value that is grabbing the filename from the full path so it is adding the workbook name onto the current value. For example, when I ran it, it didn't find the value in the list because it was looking for "Book2Book1" and not simply "Book2."

Extremely easy fix on that, though. Just add

temp = ""

to the code inside the loop. Example:

For i = 1 To .FoundFiles.Count

            ' reset the 'temp' variable
            temp = ""

            'this returns the full path of the file
            Filenm = .FoundFiles(i)

That should fix that, then. Sorry about that