Thread: File properties (size date)

How can I obtain information similar to the optput of a DOS dir command?
(filenames, sizes, dates, etc.)

My preference is to use File Scripting Objects for this kind of thing. Here
is some code that seraches a directory (and subdirectories if the last
argument is set to true) and returns some properties about the files found...

To use this you MUST reference your project to "Microsoft Scripting Runtime"
(Tools -> References -> Microsoft Scripting Runtime)

Option Explicit
Option Compare Text

Sub test()
Call ListFiles("C:\Test", Sheets("Sheet1").Range("A2"), "xls", True)
End Sub

Public Sub ListFiles(ByVal strPath As String, _
ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _
Optional ByVal blnSubDirectories As Boolean = False)
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim strName As String

'Specify the file to look for...
strName = "*." & strFileType
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strPath)

For Each objFile In objFolder.Files
If objFile.Name Like strName Then
rngDestination.Value = objFile.Path
rngDestination.Offset(0, 1).Value = objFile.DateLastAccessed
rngDestination.Offset(0, 2).Value = objFile.Size
'You can add more properties of objFile.
Set rngDestination = rngDestination.Offset(1, 0)
End If
Next 'objFile
Set objFile = Nothing

'Call recursive function
If blnSubDirectories = True Then _
DoTheSubFolders objFolder.SubFolders, rngDestination, strName

Set objFSO = Nothing
Set objFolder = Nothing
End Sub


Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
ByRef rng As Range, ByRef strTitle As String)
Dim scrFolder As Scripting.Folder
Dim scrFile As Scripting.File
Dim lngCnt As Long

On Error GoTo ErrorHandler
For Each scrFolder In objFolders
For Each scrFile In scrFolder.Files
If scrFile.Name Like strTitle Then
rng.Value = scrFile.Path
rng.Offset(0, 1).Value = scrFile.DateLastAccessed
Set rng = rng.Offset(1, 0)
End If
Next 'scrFile

'If there are more sub folders then go back and run function again.
If scrFolder.SubFolders.Count > 0 Then
DoTheSubFolders scrFolder.SubFolders, rng, strTitle
End If
ErrorHandler:
Next 'scrFolder

Set scrFile = Nothing
Set scrFolder = Nothing
End Function
'-------------------

--
HTH...

Jim Thomlinson


"Christmas May" wrote:

> How can I obtain information similar to the optput of a DOS dir command?
> (filenames, sizes, dates, etc.)

Mr. Jim Thomlinson,

Thanks for the information. I used your example below as well as some
examples in the Microsoft Windows 2000 Scripting Guide (See section relating
to "recursion"). To generate what I need.

I'm considering this issue closed.

Sincerely,

Christmas May



"Jim Thomlinson" wrote:

> My preference is to use File Scripting Objects for this kind of thing. Here
> is some code that seraches a directory (and subdirectories if the last
> argument is set to true) and returns some properties about the files found...
>
> To use this you MUST reference your project to "Microsoft Scripting Runtime"
> (Tools -> References -> Microsoft Scripting Runtime)
>
> Option Explicit
> Option Compare Text
>
> Sub test()
> Call ListFiles("C:\Test", Sheets("Sheet1").Range("A2"), "xls", True)
> End Sub
>
> Public Sub ListFiles(ByVal strPath As String, _
> ByVal rngDestination As Range, Optional ByVal strFileType As String = "*", _
> Optional ByVal blnSubDirectories As Boolean = False)
> Dim objFSO As Scripting.FileSystemObject
> Dim objFolder As Scripting.Folder
> Dim objFile As Scripting.File
> Dim strName As String
>
> 'Specify the file to look for...
> strName = "*." & strFileType
> Set objFSO = New Scripting.FileSystemObject
> Set objFolder = objFSO.GetFolder(strPath)
>
> For Each objFile In objFolder.Files
> If objFile.Name Like strName Then
> rngDestination.Value = objFile.Path
> rngDestination.Offset(0, 1).Value = objFile.DateLastAccessed
> rngDestination.Offset(0, 2).Value = objFile.Size
> 'You can add more properties of objFile.
> Set rngDestination = rngDestination.Offset(1, 0)
> End If
> Next 'objFile
> Set objFile = Nothing
>
> 'Call recursive function
> If blnSubDirectories = True Then _
> DoTheSubFolders objFolder.SubFolders, rngDestination, strName
>
> Set objFSO = Nothing
> Set objFolder = Nothing
> End Sub
>
>
> Function DoTheSubFolders(ByRef objFolders As Scripting.Folders, _
> ByRef rng As Range, ByRef strTitle As String)
> Dim scrFolder As Scripting.Folder
> Dim scrFile As Scripting.File
> Dim lngCnt As Long
>
> On Error GoTo ErrorHandler
> For Each scrFolder In objFolders
> For Each scrFile In scrFolder.Files
> If scrFile.Name Like strTitle Then
> rng.Value = scrFile.Path
> rng.Offset(0, 1).Value = scrFile.DateLastAccessed
> Set rng = rng.Offset(1, 0)
> End If
> Next 'scrFile
>
> 'If there are more sub folders then go back and run function again.
> If scrFolder.SubFolders.Count > 0 Then
> DoTheSubFolders scrFolder.SubFolders, rng, strTitle
> End If
> ErrorHandler:
> Next 'scrFolder
>
> Set scrFile = Nothing
> Set scrFolder = Nothing
> End Function
> '-------------------
>
> --
> HTH...
>
> Jim Thomlinson
>
>
> "Christmas May" wrote:
>
> > How can I obtain information similar to the optput of a DOS dir command?
> > (filenames, sizes, dates, etc.)