How can I skip a (Sub)Folder in a Scan?
 

Hi

I've tried out Bob Phillip's clever code of creating a list of files within a main folder (and drilling down into all subfolders), pasted below

I am using this to create a list of files within a particular directory (say, N:\Main Dir) to identify files which have been out-of-date and may be archived for space

Unfortunately, I've run into folders that have 'Permission Denied' (Error # 70), tripping up the macro. How can I get the macro to skip to the next folder when it hits this error? I have tried a simple "On Error Resume Next", but it gives weird results (not all files listed, some file names missing etc)

Thanks a million for your help

SuperJas

--------------------------------------------------------

Option Explici

Private Declare Function SHGetPathFromIDList Lib "shell32.dll"
Alias "SHGetPathFromIDListA"
(ByVal pidl As Long,
ByVal pszPath As String) As Lon

Private Declare Function SHBrowseForFolder Lib "shell32.dll"
Alias "SHBrowseForFolderA"
(lpBrowseInfo As BROWSEINFO) As Lon

Private Type BROWSEINF
hOwner As Lon
pidlRoot As Lon
pszDisplayName As Strin
lpszTitle As Strin
ulFlags As Lon
lpfn As Lon
lParam As Lon
iImage As Lon
End Typ

Dim FSO As Objec
Dim cnt As Lon
Dim level As Lon
Dim arFile

Sub Folders(
Dim i As Lon
Dim sFolder As Strin

Set FSO = CreateObject("Scripting.FileSystemObject"

arFiles = Array(
cnt = -
level =

sFolder = GetFolder(
ReDim arFiles(1, 0
If sFolder < "" The
SelectFiles sFolde
Worksheets.Add.Name = "Files
With ActiveShee
For i = LBound(arFiles, 2) To UBound(arFiles, 2
.Hyperlinks.Add Anchor:=.Cells(i + 1, arFiles(1, i)),
Address:=arFiles(0, i),
TextToDisplay:=arFiles(0, i
Nex
.Columns("A:Z").EntireColumn.AutoFi
End Wit
End I

End Su

'----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath
'----------------------------------------------------------------------
Dim fldr As Objec
Dim Folder As Objec
Dim file As Objec
Dim Files As Objec

Set Folder = FSO.GetFolder(sPath

Set Files = Folder.File
For Each file In File
cnt = cnt +
ReDim Preserve arFiles(1, cnt
arFiles(0, cnt) = Folder.path & "\" & file.Nam
arFiles(1, cnt) = leve
Next fil

level = level +
For Each fldr In Folder.Subfolder
SelectFiles fldr.pat
Nex

End Su

'------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = "Select a folder."
As Strin
'------------------------------------------------------------
Dim bInfo As BROWSEINF
Dim path As Strin
Dim oDialog As Lon

bInfo.pidlRoot = 0& 'Root folder = Deskto

bInfo.lpszTitle = Nam

bInfo.ulFlags = &H1 'Type of directory to Retur
oDialog = SHBrowseForFolder(bInfo) 'display the dialo

'Parse the resul
path = Space$(512

GetFolder = "
If SHGetPathFromIDList(ByVal oDialog, ByVal path) The
GetFolder = Left(path, InStr(path, Chr$(0)) - 1
End I

End Functio

How can I skip a (Sub)Folder in a Scan?
 

On what line of code does the error crop up? I am guessing you need to be
more surgical with your error handling. Catch the specific error in
procedure where it occurs, goto an error handler, clean up, then have the
code restart where it can try to get the *next* folder using Resume <label
in your error handler.

On Error Goto errhandler
get_folder:
'code gets next folder here
'more code
Exit Sub
errhandler:
'code to clean up, if nec.
Resume get_folder 'go try next.
Ens Sub

"SuperJas" wrote in message
...
Hi,

I've tried out Bob Phillip's clever code of creating a list of files
within a main folder (and drilling down into all subfolders), pasted below.

I am using this to create a list of files within a particular directory
(say, N:\Main Dir) to identify files which have been out-of-date and may be
archived for space.

Unfortunately, I've run into folders that have 'Permission Denied' (Error
# 70), tripping up the macro. How can I get the macro to skip to the next
folder when it hits this error? I have tried a simple "On Error Resume
Next", but it gives weird results (not all files listed, some file names
missing etc).

Thanks a million for your help!

SuperJas.

---------------------------------------------------------

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Dim FSO As Object
Dim cnt As Long
Dim level As Long
Dim arFiles

Sub Folders()
Dim i As Long
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

arFiles = Array()
cnt = -1
level = 1

sFolder = GetFolder()
ReDim arFiles(1, 0)
If sFolder < "" Then
SelectFiles sFolder
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
.Hyperlinks.Add Anchor:=.Cells(i + 1, arFiles(1, i)),
_
Address:=arFiles(0, i), _
TextToDisplay:=arFiles(0, i)
Next
.Columns("A:Z").EntireColumn.AutoFit
End With
End If

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(ByVal sPath)
'-----------------------------------------------------------------------
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object

Set Folder = FSO.GetFolder(sPath)

Set Files = Folder.Files
For Each file In Files
cnt = cnt + 1
ReDim Preserve arFiles(1, cnt)
arFiles(0, cnt) = Folder.path & "\" & file.Name
arFiles(1, cnt) = level
Next file

level = level + 1
For Each fldr In Folder.Subfolders
SelectFiles fldr.path
Next

End Sub


'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = "Select a folder.")
As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to
Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function