Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
Help needed from 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" wrote in message ... 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" wrote in message ... 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:D").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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Tom Ogilvy | Excel Worksheet Functions | |||
Thank You Tom Ogilvy | Excel Worksheet Functions | |||
Thank u Tom Ogilvy | Excel Programming | |||
Tom Ogilvy | Excel Programming | |||
Help Tom Ogilvy | Excel Programming |