I have pieced together a script that works except for one problem. Where I call for ofsd it returns todays date instead of the date the file was last modified or created. Unfortunetly I have not been able to get anything else I have found on the net to work. Any help would be HUGELY appreciated.
Code:
Public Function FillDirToTable(colDirList As Collection _
, ByVal strFolder As String _
, strFileSpec As String _
, bIncludeSubfolders As Boolean)
'Allen Browne's code using Recursion, Collections, and the Dir() Function
'to find all Files in any Folder/Sub-Folder combination, that matches a
'specific File Specification (FileSpec).
'Build up a list of files, and then add add to this list, any additional folders
On Error Resume Next
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim oFS As Object
Dim ofsd As String
On Error Resume Next
'Add the files to the folder.
strFolder = TrailingSlash(strFolder) 'produces ..Folder\
'strTemp returns the FileName matching the FileSpec in strFolder
strTemp = Dir(strFolder & strFileSpec) 'produces ..Folder\*.FileSpec
'This creates an instance of the MS Scripting Runtime FileSystemObject class
Set oFS = CreateObject("Scripting.FileSystemObject")
ofsd = oFS.GetFile(strTemp).Datelastmodified
ofsd = Format(Date, "-(mmm -dd- YYYY)-")
Do While strTemp <> vbNullString 'as long as FileNames are returned
Forms!frmtest![lstFilesInDirectory].AddItem ofsd & "--------" & strTemp
strTemp = Dir 'Recursively call the Dir() Function
Loop
If bIncludeSubfolders Then
'Build collection of additional subfolders and search for any
'Sub-Folders under strFolder
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
'If Sub-Folder, add to colFolders Collection
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir 'Recursively call the Dir() Function
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
'..Folder\Sub-Folder\----------------'
Call FillDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If
End Function