List Files in a Folder

There are a number of ways to do this;
Here is one of them.
1)Lists Files (Full path name)
2)File size
3)File date

'---------------------------------------------------------------------------------------
' Module : Mod_DirInfo
' DateTime : 8/01/01 18:06
' Author : Ivan F Moala
' Purpose : Lists xls File info
' Inputs : Directory
' Outputs : Full path name of file,size Kb of file,Date time of File
'---------------------------------------------------------------------------------------
Option Explicit
Option Base 1

Dim KbSum As Double
Const Dmsg = "Select the Directory to get xls File info from"

'Code for generating list of files in a directory...
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public 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

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If

End Function

Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileSearch
Dim FileArray() As Variant
Dim i As Double
Dim Exists

On Error GoTo ErrSearch
Set FileSearch = Application.FileSearch

If Right(FileSpec, 1) <> "\" Then FileSpec = FileSpec & "\"

Exists = Dir(FileSpec)
If Exists = "" Then GoTo ErrSearch

'Reset KbSum
KbSum = 0
With FileSearch
.NewSearch
.LookIn = FileSpec
.FileName = "*.xls"
If .Execute > 0 Then
ReDim FileArray(.FoundFiles.Count, 3)
For i = 1 To .FoundFiles.Count
FileArray(i, 1) = .FoundFiles(i)
KbSum = KbSum + FileLen(.FoundFiles(i)) \ 1024
FileArray(i, 2) = FileLen(.FoundFiles(i)) \ 1024 & " Kb"
FileArray(i, 3) = Format(FileDateTime(.FoundFiles(i)), "dd/mm/yy hh:mm:ss")
Next
Else
GetFileList = False
Exit Function
End If
End With

GetFileList = FileArray
Set FileSearch = Nothing

Exit Function
' Error handler
ErrSearch:

If Exists = "" Then On Error Resume Next: Err.Raise 76
MsgBox Err.Number & " : " & Err.Description, vbMsgBoxHelpButton, _
"Error Search", Err.HelpFile, Err.HelpContext
End
End Function

Sub ListToSheet_FileInfo()
Dim Dir_ToLookIn As String, x As Variant, i As Double

Dir_ToLookIn = GetDirectory(Dmsg)
x = GetFileList(Dir_ToLookIn)

Select Case IsArray(x)

Case True 'Files found

ActiveSheet.Range("A:C").Clear
[A1] = UBound(x) & " Files in Dir:= " & Dir_ToLookIn
[B1] = KbSum & " Kb"
[C1] = "File Date"

With Range("A1:C1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 5
End With
With ActiveSheet
.Range("A2").Resize(UBound(x), 3) = x
.Range("A:C").Columns.AutoFit
End With
MsgBox "Done!....", vbInformation

Case False 'No files found
MsgBox "No matching files", vbCritical

End Select

x = ""

End Sub

HTH

Ivan