List Files in a Folder/Subfolder

[James]

How can I scan through a Folder & Subfolders & list the
files as Hyperlink in a Indented format. Is it possible in
XL 2002 , win 2k VBA

Thanks a lot for your help
James

 

[Frank Kabel]

Hi
have a look at this discussion:
http://tinyurl.com/3g3eq

 

[James]

Hi Frank
Thanks a million for quick reply. The code worked but I
was hoping for different result.
I was hoping if possible to List in the followng format

Folder Name
File Name (without the full path) : Hyperlink
..
..
Folder Name
File Name (without the full Path) : Hyperlink
..
..
End

Please advise if possible
Thanks
james

 

[Frank Kabel]

Hi
try

Sub FindFiles()
Dim myPath As String
Dim lLen As Long, i As Long
Dim parts
myPath = "D:\temp" 'change to your needs
With Application.FileSearch
.NewSearch
.LookIn = myPath
.SearchSubFolders = True
.Filename = "*.*"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
parts = Split(.FoundFiles(i), "\")
Cells(i, 1) = parts(UBound(parts))
Cells(i, 2).FormulaR1C1 = "=Hyperlink(" & Chr(34) &
..FoundFiles(i) _
& Chr(34) & ",R[0]C[-1])"
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

 

[Bob Phillips]

James,

Here is a solution that browses for the folder to list from

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

'----------------------------- end-script -----------------------------



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[James]

Wow!!! You got so close..
All I am missing now is the Folder name as Header when
ever there is change in Folder. I guess I have troubled
you enough, I'll try to find some way around it.
Thanks a lot

-----Original Message-----
Hi
try

Sub FindFiles()
Dim myPath As String
Dim lLen As Long, i As Long
Dim parts
myPath = "D:\temp" 'change to your needs
With Application.FileSearch
.NewSearch
.LookIn = myPath
.SearchSubFolders = True
.Filename = "*.*"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
parts = Split(.FoundFiles(i), "\")
Cells(i, 1) = parts(UBound(parts))
Cells(i, 2).FormulaR1C1 = "=Hyperlink(" & Chr(34) &
..FoundFiles(i) _
& Chr(34) & ",R[0]C[-1])"
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub


--
Regards
Frank Kabel
Frankfurt, Germany

Hi Frank
Thanks a million for quick reply. The code worked but I
was hoping for different result.
I was hoping if possible to List in the followng format

Folder Name
File Name (without the full path) : Hyperlink
.
.
Folder Name
File Name (without the full Path) : Hyperlink
.
.
End

Please advise if possible
Thanks
james

.