Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
can it be modified to filter & list *.xls files only?
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 |
#2
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
can it be modified to filter & list *.xls files only?
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 |
#3
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
can it be modified to filter & list *.xls files only?
Tom you are great...
Simple and effective Thanks a lot. "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 |
#4
Posted to microsoft.public.excel,microsoft.public.excel.programming
|
|||
|
|||
can it be modified to filter & list *.xls files only?
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
filter: how to print filter list options in dropdown box | Excel Discussion (Misc queries) | |||
Use date modified to change format & create filter to track change | Excel Worksheet Functions | |||
How do I find a list of dates a file has been modified? | Excel Discussion (Misc queries) | |||
Modified files | Excel Discussion (Misc queries) | |||
my excel files being modified by a virus | Excel Discussion (Misc queries) |