List Files in a Directory

Submitted by Nathan P. Oliver of Minneapolis, MN. Nathan is a financial consultant and application developer.

This program returns the filename, size, and date modified of all files in the selected directory and its subfolders:

Private Sub Srch()

Dim i As Long, z As Long, ws As Worksheet, y As Variant Dim fLdr As String y = Application.InputBox("Please Enter File Extension", "Info Request") If y = False And Not TypeName(y) = "String" Then Exit Sub Application.ScreenUpdating = False fLdr = BrowseForFolderShell With Application.FileSearch .NewSearch .LookIn = fLdr .SearchSubFolders = True .Filename = y

Set ws = ThisWorkbook.Worksheets.Add(Sheets(1)) On Error GoTo 1 2: ws.Name = "FileSearch Results" On Error GoTo 0 If .Execute() > 0 Then

For i = 1 To .FoundFiles.Count

If Left$(.FoundFiles(i), 1) = Left$(fLdr, 1) Then If CBool(Len(Dir(.FoundFiles(i)))) Then z = z + 1

ws.Cells(z + 1, 1).Resize(, 3) = _ Array(Dir(.FoundFiles(i)), _

FileLen(.FoundFiles(i)) \ 1000, _ FileDateTime(.FoundFiles(i))) ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1), _ Address:=.FoundFiles(i)

End If End If Next i End If End With

ActiveWindow.DisplayHeadings = False With ws

.Value = [{"Full Name","Kilobytes","Last Modified"}] .Font.Underline = xlUnderlineStyleSingle .EntireColumn.AutoFit .HorizontalAlignment = xlCenter End With

.[d1:iv1].EntireColumn.Hidden = True Range(.[a65536].End(3)(2), _

.[a65536]).EntireRow.Hidden = True Range(.[a2], ,[c65536]).Sort [a2], xlAscending, header:=xlNo End With

Application.ScreenUpdating = True Exit Sub

1: Application.DisplayAlerts = False

Worksheets("FileSearch Results").Delete Application.DisplayAlerts = True GoTo 2

End Sub

Function BrowseForFolderShell() As String Dim objShell As Object, objFolder As Object

Set objShell = CreateObject("Shell.Application") ' Uncomment next line to start at desktop

'Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, 0)

'*** Specify Starting Browse Location

Set objFolder = objShell.BrowseForFolder(0, _

"Please select a folder", 0, "c:\") If (Not objFolder Is Nothing) Then On Error Resume Next

If IsError(objFolder.Items.Item.Path) Then BrowseForFolderShell = _

CStr(objFolder): GoTo Here On Error GoTo 0

0 0

Post a comment