Skip password protect files and open non protected files

[Boss]

Hi,

I am using the below code to password protect all the files in a folder and
its subfodlers.

The code opens all the files one by one and saves them with a password. If
any file is password protected macro gives me an error.

please help me solve this... I tried with a error handler which will move to
next file on a error but didnt worked properly.



Sub ExecuteListFiles()
Range("A20").Select
Application.ScreenUpdating = False
Application.StatusBar = "Processing... "

Dim strpathfile As String
strpathfile = Range("c6").Value 'sets path
Call ListFilesInFolder(strpathfile, True)

Application.ScreenUpdating = True
Application.StatusBar = ""
Range("A1").Select
MsgBox ("Done with all files"), vbExclamation
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
Dim FSO As New FileSystemObject, SourceFolder As Folder, Subfolder As
Folder, FileItem As File
Dim lngCount As Long, strSQL As String
Dim pptfile As Object
Dim ws As Worksheet

Set SourceFolder = FSO.GetFolder(SourceFolderName)
For Each FileItem In SourceFolder.Files
ActiveCell.Value = FileItem
ActiveCell.Offset(1, 0).Select
Select Case Right(FileItem.Name, 3) ' finds extension of file


'******************************** Excel ************************************
Case "xls" ' finds excel file
Application.DisplayAlerts = False
Workbooks.Open (FileItem), Password:=""

For Each ws In ActiveWorkbook.Worksheets
With ws.PageSetup
.LeftFooter = "&BData Classification : Highly Confidential&B"
End With
Next ws
' password for excel
ActiveWorkbook.SaveAs FileName:=FileItem, FileFormat:=xlNormal,
Password:="test", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True

End Select
' loop in folders and sub folders
lngCount = lngCount + 1
Next FileItem
If IncludeSubfolders Then
For Each Subfolder In SourceFolder.SubFolders
ListFilesInFolder Subfolder.path, True
Next Subfolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing

End Sub


Thx!

 

[joel]

Normally when a protected workbook is opened you are pormpted for a
password. When you set DisplayAlerts to False the you don't see the
prompt for the password. So the code continues and you get an error
when you try to make a change to the workbook further in the code. You
need to then need to unprotect the workbook before making any changes.



From:
Application.DisplayAlerts = False
Workbooks.Open (FileItem), Password:=""

To:
Application.DisplayAlerts = False
err.clear
Workbooks.Open (FileItem), Password:=""
'write to workbook to see if there is an error
On Error goto 100
Range("IV1") = 1
on Error goto 0


Error routine

100:
thisworkbook.unprotect Password:="test"
err.clear
Resume

 

[Boss]

Thanks a lot for helping me on this.

But still i am unable to solve this... Please let me know what changes
should i do in the code so that it skips the file with password and open only
those file which does not have a password.

the error hander is passing an error in second file.

thx!

 

[joel]

does this mean it now works for one file and not a second file? If so
the error handler may be in the wrong place or the error is not being
reset properly. I need to know if it works for one file before I
continue.

 

[Boss]

Thx for the reply...

The error handler catches the error on first file and goes to the next item.
In the second file it fails to catch the error and code debugs.

How do we reset the errr handler. Please help

Thx!

 

[joel]

I just checked the Err.Clear help file and it says it is not neede
because the Resume will automatically clear the error. Try removing th
Err.Clear it may have negative side effects

 

[Boss]

Thanks Joel,

But still i am stuck up.

when i initially posted the code it was working for first file and not for
the second file.
If clearing the err is not the issue what changes should i make in the code.
I have not added resume to the err handler. Please hlep.

Thx!

 

[Boss]

Hi,

Really stuck up with this now...

This code below protectes all the .doc, .xls, .ppt files in folder and its
subfolders.
If the files are already protected then it skips only first file and debugs
on second.


please help.. this is something very ungent for me...

Thx!


Sub ExecuteListFiles()
Range("A20").Select
Application.ScreenUpdating = False
Application.StatusBar = "Processing... "

Dim strpathfile As String
strpathfile = Range("c6").Value 'sets path
Call ListFilesInFolder(strpathfile, True)

Application.ScreenUpdating = True
Application.StatusBar = ""
lnggCount = Range("A1").Value
Range("A1").Select
Range("A1").ClearContents
MsgBox ("Password protected " & lnggCount & " files"), vbExclamation
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
Dim FSO As New FileSystemObject, SourceFolder As Folder, Subfolder As
Folder, FileItem As File
Dim lngCount As Long, strSQL As String
Dim pptfile As Object
Dim ws As Worksheet
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo err
For Each FileItem In SourceFolder.Files
ActiveCell.Value = FileItem
ActiveCell.Offset(1, 0).Select

Select Case Right(FileItem.Name, 3) ' finds extension of file

'******************************** Word ************************************
Case "doc" ' finds word file
Set docfile = CreateObject("Word.Application")
'docfile.Visible = True
docfile.Documents.Open (FileItem), Password:=""


With docfile.ActiveDocument
.Password = "test" ' word password
End With

docfile.ActiveDocument.Close
docfile.Quit

'******************************** power point
************************************
Case "ppt" ' finds powerpoint file
Set pptfile = CreateObject("powerpoint.application")
pptfile.Visible = True
Set pShow = pptfile.Presentations.Open(FileItem)

With pShow
.Password = "test" ' ppt password
.SaveAs FileItem
.Close
End With
pptfile.Quit

'******************************** Excel ************************************
Case "xls" ' finds excel file

'Application.DisplayAlerts = False
Workbooks.Open (FileItem), Password:=""

For Each ws In ActiveWorkbook.Worksheets
With ws.PageSetup
.LeftFooter = "&BData Classification : Highly Confidential&B"
End With
Next ws
' password for excel
ActiveWorkbook.SaveAs FileName:=FileItem, FileFormat:=xlNormal,
Password:="test", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close savechanges:=True
'Application.DisplayAlerts = True

End Select
' loop in folders and sub folders

lngCount = lngCount + 1
err:
Next FileItem
If IncludeSubfolders Then
For Each Subfolder In SourceFolder.SubFolders
ListFilesInFolder Subfolder.path, True
Next Subfolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Range("a1").Value = lngCount

End Sub


End Function

I just checked the Err.Clear help file and it says it is not needed
because the Resume will automatically clear the error. Try removing the
Err.Clear it may have negative side effects.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=157418

Microsoft Office Help

.

 

[joel]

I learn something new all the time. I saw a different posting las
night with this code

If Worksheets("Sheet1").ProtectContents = True Then
MsgBox "The contents of Sheet1 are protected."
End If

or In your case

from
set bk = Workbooks.Open (filename:=FileItem, Password:="")
On Error goto 100
bk.activesheet.Range("IV1") = 1
on Error goto 0

to

set bk = Workbooks.Open (filename:=FileItem, Password:="")
If bk.ProtectContents = False Then
'enter your code here
End I

 

[Boss]

Thanks Joel... You helped me a lot... The code works fine now...