Hi,
The below code successfully lists all files from the selected drive
(including all subfolders).
I need to modify it to list the "*.xls" files only. Can someone show me
how?.
TIA

Here goes...
==================
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

Set FSO = CreateObject("Scripting.FileSystemObject")

arFiles = Array()
cnt = 0
level = 1

ReDim arFiles(3, 0)
arFiles(0, 0) = GetFolder()
If arFiles(0, 0) <> "" Then
arFiles(1, 0) = level
SelectFiles arFiles(0, 0)

Worksheets.Add.Name = "Files"
With ActiveSheet
.Cells(1, 1).Value = "Path"
.Cells(1, 2).Value = "FileName"
.Cells(1, 3).Value = "Date"
.Cells(1, 4).Value = "Size"
.Rows(1).Font.Bold = True
.Columns(4).NumberFormat = "#,##0 "" KB"""
cnt = 1
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
.Cells(i + 2, 1).Value = arFiles(0, i)
.Cells(i + 2, 2).Value = arFiles(1, i)
.Cells(i + 2, 3).Value = arFiles(2, i)
.Cells(i + 2, 4).Value = arFiles(3, i) / 1024
' alttaki satýr badmin e ait.
ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2, 2),
Address:=arFiles(0, i) & "\" & arFiles(1, i)
Next
.Columns("A").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
If (file.Attributes And 2 Or _
file.Attributes And 4) Then
'
Else
cnt = cnt + 1
ReDim Preserve arFiles(3, cnt)
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
arFiles(3, cnt) = file.Size
End If
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&

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1
oDialog = SHBrowseForFolder(bInfo)


path = Space$(512)

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

End Function

maybe here
Else
if Instr(1,file.name,".xls",vbTextCompare) > 0 then
cnt = cnt + 1
ReDim Preserve arFiles(3, cnt)
arFiles(0, cnt) = Folder.path
arFiles(1, cnt) = file.Name
arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
arFiles(3, cnt) = file.Size
End if
End If

--
Regards,
Tom Ogilvy

"Jack" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi,
> The below code successfully lists all files from the selected drive
> (including all subfolders).
> I need to modify it to list the "*.xls" files only. Can someone show me
> how?.
> TIA
>
> Here goes...
> ==================
> 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
>
> Set FSO = CreateObject("Scripting.FileSystemObject")
>
> arFiles = Array()
> cnt = 0
> level = 1
>
> ReDim arFiles(3, 0)
> arFiles(0, 0) = GetFolder()
> If arFiles(0, 0) <> "" Then
> arFiles(1, 0) = level
> SelectFiles arFiles(0, 0)
>
> Worksheets.Add.Name = "Files"
> With ActiveSheet
> .Cells(1, 1).Value = "Path"
> .Cells(1, 2).Value = "FileName"
> .Cells(1, 3).Value = "Date"
> .Cells(1, 4).Value = "Size"
> .Rows(1).Font.Bold = True
> .Columns(4).NumberFormat = "#,##0 "" KB"""
> cnt = 1
> For i = LBound(arFiles, 2) To UBound(arFiles, 2)
> .Cells(i + 2, 1).Value = arFiles(0, i)
> .Cells(i + 2, 2).Value = arFiles(1, i)
> .Cells(i + 2, 3).Value = arFiles(2, i)
> .Cells(i + 2, 4).Value = arFiles(3, i) / 1024
> ' alttaki satýr badmin e ait.
> ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2, 2),
> Address:=arFiles(0, i) & "\" & arFiles(1, i)
> Next
> .Columns("A").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
> If (file.Attributes And 2 Or _
> file.Attributes And 4) Then
> '
> Else
> cnt = cnt + 1
> ReDim Preserve arFiles(3, cnt)
> arFiles(0, cnt) = Folder.path
> arFiles(1, cnt) = file.Name
> arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
> arFiles(3, cnt) = file.Size
> End If
> 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&
>
> bInfo.lpszTitle = Name
>
> bInfo.ulFlags = &H1
> oDialog = SHBrowseForFolder(bInfo)
>
>
> path = Space$(512)
>
> GetFolder = ""
> If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
> GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
> End If
>
> End Function
>
>
>
>

Tom you are great...
Simple and effective
Thanks a lot.


"Tom Ogilvy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> maybe here
> Else
> if Instr(1,file.name,".xls",vbTextCompare) > 0 then
> cnt = cnt + 1
> ReDim Preserve arFiles(3, cnt)
> arFiles(0, cnt) = Folder.path
> arFiles(1, cnt) = file.Name
> arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
> arFiles(3, cnt) = file.Size
> End if
> End If
>
> --
> Regards,
> Tom Ogilvy
>

Dear Tom,
Can I add up a follow-up question here?.
Can I present an Input Box (+message box) just before the filtering criteria
and let the user decide what extention to search for (i.e...*.doc, *.mp3,
....*.zip etc) for crearting the list?.
TIA


"Tom Ogilvy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> maybe here
> Else
> if Instr(1,file.name,".xls",vbTextCompare) > 0 then
> cnt = cnt + 1
> ReDim Preserve arFiles(3, cnt)
> arFiles(0, cnt) = Folder.path
> arFiles(1, cnt) = file.Name
> arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
> arFiles(3, cnt) = file.Size
> End if
> End If
>
> --
> Regards,
> Tom Ogilvy
>
> "Jack" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi,
> > The below code successfully lists all files from the selected drive
> > (including all subfolders).
> > I need to modify it to list the "*.xls" files only. Can someone show me
> > how?.
> > TIA
> >
> > Here goes...
> > ==================
> > 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
> >
> > Set FSO = CreateObject("Scripting.FileSystemObject")
> >
> > arFiles = Array()
> > cnt = 0
> > level = 1
> >
> > ReDim arFiles(3, 0)
> > arFiles(0, 0) = GetFolder()
> > If arFiles(0, 0) <> "" Then
> > arFiles(1, 0) = level
> > SelectFiles arFiles(0, 0)
> >
> > Worksheets.Add.Name = "Files"
> > With ActiveSheet
> > .Cells(1, 1).Value = "Path"
> > .Cells(1, 2).Value = "FileName"
> > .Cells(1, 3).Value = "Date"
> > .Cells(1, 4).Value = "Size"
> > .Rows(1).Font.Bold = True
> > .Columns(4).NumberFormat = "#,##0 "" KB"""
> > cnt = 1
> > For i = LBound(arFiles, 2) To UBound(arFiles, 2)
> > .Cells(i + 2, 1).Value = arFiles(0, i)
> > .Cells(i + 2, 2).Value = arFiles(1, i)
> > .Cells(i + 2, 3).Value = arFiles(2, i)
> > .Cells(i + 2, 4).Value = arFiles(3, i) / 1024
> > ' alttaki satýr badmin e ait.
> > ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2, 2),
> > Address:=arFiles(0, i) & "\" & arFiles(1, i)
> > Next
> > .Columns("A").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
> > If (file.Attributes And 2 Or _
> > file.Attributes And 4) Then
> > '
> > Else
> > cnt = cnt + 1
> > ReDim Preserve arFiles(3, cnt)
> > arFiles(0, cnt) = Folder.path
> > arFiles(1, cnt) = file.Name
> > arFiles(2, cnt) = Format(file.DateCreated, "dd mmm yyyy")
> > arFiles(3, cnt) = file.Size
> > End If
> > 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&
> >
> > bInfo.lpszTitle = Name
> >
> > bInfo.ulFlags = &H1
> > oDialog = SHBrowseForFolder(bInfo)
> >
> >
> > path = Space$(512)
> >
> > GetFolder = ""
> > If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
> > GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
> > End If
> >
> > End Function
> >
> >
> >
> >
>
>