Ron Rosenfeld used his keyboard to write :
Hi Ron,
I assume you're running without an 'Option Explicit' statement OR you
have dimmed the other vars at the module level or higher, or in a
class. Not that it matters, just making note of it<g>. There's too much
missing to test this properly, so here's what I did:
Sub ShowSubFolders(sFldr As String)
Dim subFldrs As Object, subFldr As Object, F As Variant
Dim FSO As Object, FLS As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set subFldrs = FSO.GetFolder(sFldr).subFolders
For Each subFldr In subFldrs
' If Not subFldr.Attributes And Alias Then
If Not subFldr.Attributes Then
Application.StatusBar = "Processing folder: " & subFldr
' If Not subFldr.Attributes And System Then
If Not subFldr.Attributes Then
On Error GoTo PermissionDenied
Set FLS = subFldr.Files
Dim i As Integer
For Each F In FLS
' If re.Test(F.Name) = True Then
Cells(i + 1, 1).Value = F.Path
i = i + 1
' End If
Next F
ShowSubFolders (subFldr)
End If
End If
PermissionDenied:
If Error < "" Then Debug.Print Error, subFldr
On Error GoTo 0
Next subFldr
End Sub
This work nicely on XL12 XP SP3, so I tried it on Win7x64 XL12. Here's
what I got passing "C:\":
C:\MSOCache Run-time error '70': Permission denied
C:\Perflogs Run-time error '70': Permission denied
C:\ProgramData\Desktop Run-time error '70': Permission denied
C:\ProgramData\Documents Run-time error '70': Permission denied
C:\Recovery Run-time error '70': Permission denied
All others listed without error. Not sure what your 'Alias' and
'System' vars are.
HTH
Thanks for your suggestions.
Do you mean, in what you wrote, that NOTHING was listed in the
Immediate Window? If so, then it seems the error routine was never
triggered on your machine, even though there clearly were run-time
errors.
I do use option explicit and the variables are Dim'd at a different
level. The "re" code is regular expression stuff to filter to the
appropriate name, and that works OK.
Alias and System are system variables that indicate those particular
attributes. System = 4 and Alias = 1024. Probably they aren't
available with late binding.
If subfldr is a Windows 7 junction, then the Alias attribute will be
set.
I was using those to filter out some of the folders that did not need
to be checked.
I, too, had no problem with similar code running under XP SP3. But
that OS did not have this UAC.
I changed my code to remove the "and System" and "and Alias"
comparisons as you did; and the only change was I got my failure at a
different point:
Immediate Window:
Permission denied C:\$Recycle.Bin\S-1-5-20
Permission denied C:\$Recycle.Bin
then got run-time error while processing
C:\MSOCache
I also changed my code to use late binding as you have above, and that
did not make any difference.
In my original code, the line in the immediate window:
Permission denied C:\MSOCache
and I then get the run-time error while processing
C:\PerfLogs
If I start Excel running "As Administrator", then the code seems to
complete; and there are no messages written in the Immediate window.
Here's the entire code:
=====================================
'Need to set reference to
' Microsoft VBScript Regular Expressions 5.5
' Microsoft Scripting Runtime
Option Explicit
Dim FSO As FileSystemObject
Dim Fldrs As Folders, Fld As Folder
Dim FLS As Files, F As File
Dim re As RegExp
Dim i As Long
Const sPat As String = "^.*\.[^.~]+~[^.~]+$"
Sub RemoveTildeFiles()
i = 1
Set FSO = New FileSystemObject
Set Fld = FSO.GetFolder("C:\")
Set FLS = Fld.Files
Cells.ClearContents
Set re = New RegExp
re.Pattern = sPat
ShowSubFolders (Fld)
Application.StatusBar = False
End Sub
Sub ShowSubFolders(sFldr As String)
Dim subFldrs As Folders, subFldr As Folder
Set subFldrs = FSO.GetFolder(sFldr).subFolders
For Each subFldr In subFldrs
If Not subFldr.Attributes And Alias Then
Application.StatusBar = "Processing folder: " & subFldr
If Not subFldr.Attributes And System Then
On Error GoTo PermissionDenied
Set FLS = subFldr.Files
For Each F In FLS
If re.Test(F.Name) = True Then
Cells(i, 1).Value = F.Path
i = i + 1
End If
Next F
ShowSubFolders (subFldr)
End If
End If
PermissionDenied: If Error <> "" Then Debug.Print Error, subFldr
On Error GoTo 0
Next subFldr
End Sub
===============================
If I copy/paste your code into my Excel, and add a calling sub:
====================
Sub ssf()
ShowSubFolders ("C:\")
End Sub
==================
I get a permission denied Run-time error '70' while processing
C:\Documents and Settings\All Users\Desktop
which is a junction.
If I uncomment the line that checks for that, and change Alias to
1024, I get the run-time permission denied error while processing
C:\MSOcache.
==========================
So, neither your code nor mine seems to work on my machine. And it
seems to have something to do with the VBA On Error routine not
trapping all of the Permission Denied errors.
However, and based in particular that you took the trouble to test
very similar code on your W7 machine, and it worked as designed, I
changed my error handling routine to put it outside the main body of
the Sub:
=========================
..
..
..
ShowSubFolders (subFldr)
End If
End If
NextSubFolder: Next subFldr
Exit Sub
PermissionDenied:
Debug.Print Error, subFldr
Resume NextSubFolder
End Sub
=============================
This seems to work OK, with a long list of files listed in the
Immediate Window (most from C:\Windows.old\Windows)
So I've got this routine working at this level.
But I wonder why the On Error routine seems to behave differently on
your machine than mine; and why having the On Error routine in the
body of the Sub seems to disable the error handler after the first or
second trap, whereas it does not when entered in the more usual
fashion.
But thank you very much for trying things on your machine. It was very
helpful.