S
SuperJas
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
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