Help with a Macro to list all filenames and mod dates in a folder

[techmoney]

Can someone please show me how I can write a script to list all files
in a particular folder.

Example:

C:\Rosters\Nov 2004\

AAA.xls
BBB.doc
CCC.csv


I would like to have a list of the files on column A of a Excel
Spreadsheet...with Modified Date to. The number of files in the
folder will be dynamic

Thanks in advance!

 

[David McRitchie]

there is a recent long thread on something along the lines
of your question, but you might want to check

This posting by Jan Karel Pieterse, that manages to create a
directory list (one level) without a macro.
http://google.com/[email protected]

For a more conventional approach with a macro:
Posting by Tom Ogilvy,
http://google.com/groups?thread=#LlfXj4I#[email protected]

 

[Rob van Gelder]

Sub test()
Const cDir = "C:\Rosters\Nov 2004\"
Dim str As String

str = Dir(cDir)
Do Until str = ""
Debug.Print str, FileDateTime(cDir & str)
str = Dir
Loop
End Sub

 

[speidlbacsi]

A bit more...


Option Explicit

Sub FileInformation()

'File information Macro
'The Macro Lists the files & file properties in a directory and it
subdirectories and writes
'it into a tab delimited text file (predefined c:\1\kismalac.txt)
' needs reference to "DS: OLE Document Properties 1.2 Object Library
or higher

Dim asdf As String ' activeworkbook

' file properties:
Dim FileName As String ' name of the file
Dim fileinfo As String ' file properties info
Dim FileSpec As String ' file name
Dim fileDatCr As Date 'DateCreated
Dim fileLastAc As Date 'DateLastAccessed
Dim fileLastMod As Date 'DateLastModified
Dim fileSiz As Double 'Size
Dim fileTyp As String 'Type
Dim filePat As String 'Path


'objects
Dim szorcs As Object 'search file
Dim fso As Object ' file sys object
Dim fs, f As Object ' to access text files
Dim DSO As DSOleFile.PropertyReader ' needs reference to "DS: OL
Document Properties 1.2 Object Library"
Set DSO = New DSOleFile.PropertyReader

'other
Dim i As Long ' from ... to
Dim mainFold As String ' main folder
Dim applicName As String

mainFold = InputBox("Please input the target folder path"
"FileProperties")
Application.ScreenUpdating = False
asdf = ActiveWorkbook.Name
applicName = Application.Caption

Set szorcs = Application.FileSearch
'On Error GoTo hiba

With szorcs
.LookIn = mainFold
.SearchSubFolders = True
.FileName = "*.*"
If .Execute() > 0 Then
Application.ScreenUpdating = False
Application.Caption = "There were " & .FoundFiles.Count & _
" file(s) found."

Application.ScreenUpdating = False

For i = 1 To .FoundFiles.Count
FileName = .FoundFiles(i)

'----------------------------------------------------------------
'write routine
'----------------------------------------------------------------


Set fso = CreateObject("Scripting.FileSystemObject")

' get file info


fileLastAc = fso.GetFile(FileName).DateLastAccessed
FileSpec = fso.GetFileName(FileName)
fileDatCr = fso.GetFile(FileName).DateCreated
fileLastMod = fso.GetFile(FileName).DateLastModified
fileSiz = fso.GetFile(FileName).Size
fileTyp = fso.GetFile(FileName).Type
filePat = fso.GetFile(FileName).Path

On Error Resume Next

' define info needed

fileinfo = FileSpec & vbTab & fileDatCr & vbTab
fileLastAc & vbTab & fileLastMod & vbTab & _
fileSiz & vbTab & fileTyp & vbTab & filePat

' insert info to text file

'Const ForReading = 1, ForWriting = 2, ForAppending
8

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("c:\1\kismalac.txt", 8) '
True, TristateFalse)
f.Write vbCrLf & fileinfo
f.Close



'--------------------------------------------------------------------
' end of write routine

'--------------------------------------------------------------------



Next i
Else
MsgBox "There were no files found."
End If


End With
GoTo vege

hiba:

fileinfo = MsgBox("Something went wrong.....", vbOKOnly)


vege:

Workbooks(asdf).Activate
Application.ScreenUpdating = True

End Su