can I list only the protected?

[J_J]

Hi,
Can we list the *.doc and *.xls files in all dir/sub directories of drive D:
which ARE protected by filename, loacation, size via VBA?
TIA
J_J

 

[Guest]

I am not sure what you mean by protected.

There is a programmatic solution using File System Object. You must be aboe
to write recursive code. One way to avoid this is as follows:

1. Get to the Command Prompt
2. Type:
dir d:\*.doc > d:\mylist.txt /b /s
<ENTER>
dir d:\*.xls >> d:\myfile.txt /b /s
<ENTER>

NOTE: the second dir command has >> whereas the first has > only.

/b means bare output, i.e. file name only
/s means span all sub directories

means create or overwrite the file name that follows.

At the end, the file d:\myfile.txt contains the names of all DOC files,
followed by the names of all XLS files.

If by 'protected' you mean whether the files have the readonly/archive,
hidden, system flags set, you can use the FileSystemObject.

Use the GetFile method against each line of d:\mytext.txt and then query the
Attributes property of the object returned by GetFile.

 

[Guest]

Just thought of another short cut:

Having got d:\myfile.txt, type the following command:

attrib < d:\myfile.txt > d:\myfileatt.txt

The file d:\myfileatt.txt contains the attributes followd by the file names.
You'd need to use the file stystem Object to get the file sizes.

 

[J_J]

Thank you AAe72E,
what I meant is thouse *.xls and *.doc files which have a "password" to be
viewed. Or thouse *.xls or *.doc files which has a macro but the macro is
password protected and the macro cant be viewed. I do not need to
unlock/remove the passwords from them. I just want to identify them.
Regards
J_J

 

[Guest]

I do not believe there is a way to tell whether an XLS or DOC file contains
codes and is protected by a password.

1. You'd need to know the password to be able to open the XLS or DOC. I do
not know of a way of specifying the password to the VBE in orer to be able to
open the project and count the lines of code in it, if any.
2. Use this to count whether it contains code:

Function xx() As Double
abc = 0
For Each comp In Application.VBE.ActiveVBProject.VBComponents
abc = abc + comp.codemodule.countoflines
Next
xx = abc
End Function

This will return 0 if there is no code or a positive integer if it does. In
order to automate this, you'd need to use VB or VBA or VBScript.

 

[J_J]

Not exactly what I was expecting...I guess.
Seems like I need to investigate a few more NG's for alternatives.
But thank you anyway for your effort.
J_J

 

[Jake Marx]

Hi J_J,

Can we list the *.doc and *.xls files in all dir/sub directories of
drive D: which ARE protected by filename, loacation, size via VBA?

I'm not sure if there's a way to tell if a workbook is protected without
trying to open it. Here is some code that will do what you are looking for
*for Excel files only*. If you want to add Word docs, you'll have to modify
it a bit.

For this code to work, you have to set a reference to "Microsoft Scripting
Runtime" via Tools | References in the VBE. If you end up adding Word to
this, you'll have to set a reference to the Microsoft Word library as well.
Also, I don't retrieve the size, but that would be pretty easy through the
FileSystemObject - I believe there is a Size property to the File object.

One caveat - this is pretty slow, especially if you're looking at lots of
folders/files. Even more so if a lot of the files are Excel workbooks, as
you have to attempt to open each one programmatically. It would probably
make sense to modify this to use *one* instance of Excel to attempt to open
the workbooks instead of opening/closing the Excel app each time. But I'll
leave that up to you - if you try and need more help, let us know.


Public Sub DEMO()
gGetProtectedWBs "c:\temp\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, rsInitialPath
End If
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rsPath As String) As Boolean
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

 

[J_J]

Hi Jake,
Thank you for your code.
You were correct on the assumption that it will take a "lot of time" to deal
with lots of files. My first attempt was a deadlock of Excel after a long
long try. That is why I decided to forget all about in changing the code to
list password protected *.doc files. But I modify the code & select a target
directory where only 40-50 XL files reside and it did well. One other
problem I encounter was that, because the XL files were actually opened I
had to deal with closing down Form,...Dailog,...etc windows as well.
Nevertheless the code maneged to list the place of the password protected XL
files.
I guess thats about all I can do about it.
Regards
J_J

Hi J_J,

Can we list the *.doc and *.xls files in all dir/sub directories of
drive D: which ARE protected by filename, loacation, size via VBA?

I'm not sure if there's a way to tell if a workbook is protected without
trying to open it. Here is some code that will do what you are looking
for *for Excel files only*. If you want to add Word docs, you'll have to
modify it a bit.

For this code to work, you have to set a reference to "Microsoft Scripting
Runtime" via Tools | References in the VBE. If you end up adding Word to
this, you'll have to set a reference to the Microsoft Word library as
well. Also, I don't retrieve the size, but that would be pretty easy
through the FileSystemObject - I believe there is a Size property to the
File object.

One caveat - this is pretty slow, especially if you're looking at lots of
folders/files. Even more so if a lot of the files are Excel workbooks, as
you have to attempt to open each one programmatically. It would probably
make sense to modify this to use *one* instance of Excel to attempt to
open the workbooks instead of opening/closing the Excel app each time.
But I'll leave that up to you - if you try and need more help, let us
know.


Public Sub DEMO()
gGetProtectedWBs "c:\temp\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, rsInitialPath
End If
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rsPath As String) As Boolean
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

 

[Jake Marx]

Hi J_J,

Try this code instead. It should be quicker and won't run workbook_open
routines. Plus, it updates the status in the Excel statusbar.

Public Sub DEMO()
gGetProtectedWBs "c:\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject
Dim xlApp As Excel.Application

On Error GoTo ErrHandler
Set fso = New Scripting.FileSystemObject
Set xlApp = New Excel.Application
With xlApp
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.UserControl = False
End With

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, xlApp, rsInitialPath
End If

ExitRoutine:
If Not xlApp Is Nothing Then
With xlApp
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
End With
xlApp.Quit
Set xlApp = Nothing
End If
Set fso = Nothing
Application.StatusBar = False
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description, vbExclamation
Resume ExitRoutine
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rxlApp As Excel.Application, rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ update user on status and allow other threads to do stuff
Application.StatusBar = "Searching " & rsPath & "..."
DoEvents

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(rxlApp, fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, rxlApp, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rxlApp As Excel.Application, rsPath As
String) As Boolean
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
rxlApp.EnableEvents = False
Application.StatusBar = "Checking for protected Workbook: " & rsPath
DoEvents
Set xlWB = rxlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")
rxlApp.EnableEvents = True

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

Hi Jake,
Thank you for your code.
You were correct on the assumption that it will take a "lot of time"
to deal with lots of files. My first attempt was a deadlock of Excel
after a long long try. That is why I decided to forget all about in
changing the code to list password protected *.doc files. But I
modify the code & select a target directory where only 40-50 XL files
reside and it did well. One other problem I encounter was that,
because the XL files were actually opened I had to deal with closing
down Form,...Dailog,...etc windows as well. Nevertheless the code
maneged to list the place of the password protected XL files.
I guess thats about all I can do about it.
Regards
J_J

Hi J_J,

Can we list the *.doc and *.xls files in all dir/sub directories of
drive D: which ARE protected by filename, loacation, size via VBA?

I'm not sure if there's a way to tell if a workbook is protected
without trying to open it. Here is some code that will do what you
are looking for *for Excel files only*. If you want to add Word
docs, you'll have to modify it a bit.

For this code to work, you have to set a reference to "Microsoft
Scripting Runtime" via Tools | References in the VBE. If you end up
adding Word to this, you'll have to set a reference to the Microsoft
Word library as well. Also, I don't retrieve the size, but that
would be pretty easy through the FileSystemObject - I believe there
is a Size property to the File object.

One caveat - this is pretty slow, especially if you're looking at
lots of folders/files. Even more so if a lot of the files are Excel
workbooks, as you have to attempt to open each one programmatically.
It would probably make sense to modify this to use *one* instance of
Excel to attempt to open the workbooks instead of opening/closing
the Excel app each time. But I'll leave that up to you - if you try
and need more help, let us know.


Public Sub DEMO()
gGetProtectedWBs "c:\temp\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, rsInitialPath
End If
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rsPath As String) As Boolean
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

 

[J_J]

Hi Jake,

Thats much better...
Now I get no errors and it is much faster.
Thanks a lot.
J_J

Hi J_J,

Try this code instead. It should be quicker and won't run workbook_open
routines. Plus, it updates the status in the Excel statusbar.

Public Sub DEMO()
gGetProtectedWBs "c:\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject
Dim xlApp As Excel.Application

On Error GoTo ErrHandler
Set fso = New Scripting.FileSystemObject
Set xlApp = New Excel.Application
With xlApp
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.UserControl = False
End With

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, xlApp, rsInitialPath
End If

ExitRoutine:
If Not xlApp Is Nothing Then
With xlApp
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
End With
xlApp.Quit
Set xlApp = Nothing
End If
Set fso = Nothing
Application.StatusBar = False
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description, vbExclamation
Resume ExitRoutine
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rxlApp As Excel.Application, rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ update user on status and allow other threads to do stuff
Application.StatusBar = "Searching " & rsPath & "..."
DoEvents

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(rxlApp, fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, rxlApp, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rxlApp As Excel.Application, rsPath As
String) As Boolean
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
rxlApp.EnableEvents = False
Application.StatusBar = "Checking for protected Workbook: " & rsPath
DoEvents
Set xlWB = rxlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")
rxlApp.EnableEvents = True

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

Hi Jake,
Thank you for your code.
You were correct on the assumption that it will take a "lot of time"
to deal with lots of files. My first attempt was a deadlock of Excel
after a long long try. That is why I decided to forget all about in
changing the code to list password protected *.doc files. But I
modify the code & select a target directory where only 40-50 XL files
reside and it did well. One other problem I encounter was that,
because the XL files were actually opened I had to deal with closing
down Form,...Dailog,...etc windows as well. Nevertheless the code
maneged to list the place of the password protected XL files.
I guess thats about all I can do about it.
Regards
J_J

Hi J_J,

J_J wrote:
Can we list the *.doc and *.xls files in all dir/sub directories of
drive D: which ARE protected by filename, loacation, size via VBA?

I'm not sure if there's a way to tell if a workbook is protected
without trying to open it. Here is some code that will do what you
are looking for *for Excel files only*. If you want to add Word
docs, you'll have to modify it a bit.

For this code to work, you have to set a reference to "Microsoft
Scripting Runtime" via Tools | References in the VBE. If you end up
adding Word to this, you'll have to set a reference to the Microsoft
Word library as well. Also, I don't retrieve the size, but that
would be pretty easy through the FileSystemObject - I believe there
is a Size property to the File object.

One caveat - this is pretty slow, especially if you're looking at
lots of folders/files. Even more so if a lot of the files are Excel
workbooks, as you have to attempt to open each one programmatically.
It would probably make sense to modify this to use *one* instance of
Excel to attempt to open the workbooks instead of opening/closing
the Excel app each time. But I'll leave that up to you - if you try
and need more help, let us know.


Public Sub DEMO()
gGetProtectedWBs "c:\temp\"
End Sub

Public Sub gGetProtectedWBs(rsInitialPath As String, _
Optional rbIncludeSubFolders As Boolean = False)
Dim fso As Scripting.FileSystemObject

Set fso = New Scripting.FileSystemObject

If fso.FolderExists(rsInitialPath) Then
mGetProtectedWBs fso, rsInitialPath
End If
End Sub

Private Sub mGetProtectedWBs(rfso As Scripting.FileSystemObject, _
rsPath As String)
Dim fil As Scripting.File
Dim fol As Scripting.Folder

'/ get files
For Each fil In rfso.GetFolder(rsPath).Files
If fil.Type = "Microsoft Excel Worksheet" Then
If gbIsWBProtected(fil.Path) Then _
Debug.Print fil.Path
End If
Next fil

'/ get subfolder, recursively call this sub
For Each fol In rfso.GetFolder(rsPath).SubFolders
mGetProtectedWBs rfso, fol.Path
Next fol
End Sub

Public Function gbIsWBProtected(rsPath As String) As Boolean
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook

On Error GoTo ErrHandler

gbIsWBProtected = True
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open(Filename:=rsPath, _
Password:="")

gbIsWBProtected = xlWB Is Nothing

ExitRoutine:
If Not xlWB Is Nothing Then
xlWB.Close False
Set xlWB = Nothing
End If
If Not xlApp Is Nothing Then
xlApp.Quit
Set xlApp = Nothing
End If
Exit Function
ErrHandler:
Resume ExitRoutine
End Function


--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]

 

[Jake Marx]

Thats much better...
Now I get no errors and it is much faster.
Thanks a lot.

No problem - glad to help.

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]