So you’ve got a folder full of documents and you want to know what’s in the folder, how big the files are, and when they were last modified? And of course you want to be able to filter and sort the list. And throw in a spiffy GUI to get your base folder!
How about a little recursive Excel macro that will do the job for you? Before Office 2007 came along, I had a macro that used Application.FileSearch to do the job. But that is apparently no longer supported. You need the FileSystemObject.
So create an Excel workbook with macros enabled (i.e., ending with .xslm)
Open your VB window, go to Tools > References… and check the Microsoft Scripting Runtime option. If you don’t see it listed, click Browse and navigate to C:\Windows\System32\scrrun.dll
Create a macro and paste the following code
Sub myFileSearch()
Dim objFSO As Scripting.FileSystemObject
'Dim myFSO As FileSearch
'Dim myFSO As String
Dim foundFile As String
Dim myofficeobject As Object
Dim myfilename As String
Dim objFolder As Folder
Dim objFile As File
Dim GetLookIn As String
Set objFSO = New FileSystemObject
GetLookIn = BrowseFolder("Where do you want to search?")
If GetLookIn = "" Then
Exit Sub
End If
Set objFolder = objFSO.GetFolder(GetLookIn)
For Each objFile In objFolder.Files
myfilename = objFile.Path
ActiveCell.Value = myfilename
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FileDateTime(myfilename)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FileLen(myfilename)
ActiveCell.Offset(1, -2).Select
Next objFile
ShowSubFolders objFolder
End Sub
Public Function ShowSubFolders(ByVal Folder As Variant)
Set objFSO = New FileSystemObject
For Each Subfolder In Folder.SubFolders
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile In colFiles
myfilename = objFile.Path
ActiveCell.Value = myfilename
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FileDateTime(myfilename)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = FileLen(myfilename)
ActiveCell.Offset(1, -2).Select
Next
If Len(Subfolder) Then
ShowSubFolders Subfolder
End If
Next
End Function
Here’s the code for the GUI
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft
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
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 Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
'*********** Code End *****************
