Maritimer
asked on
Reading files
How can I scan files in a directory and read in the name and date stamp.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Here is a site that has the API and FSO approach:
www.mvps.org/vbnet
Search for this topic:
Performance Comparison - FSO vs. API
Thanks!
Joe
www.mvps.org/vbnet
Search for this topic:
Performance Comparison - FSO vs. API
Thanks!
Joe
Option Explicit
'32 bit Windows declarations
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Function FileDate(FT As FILETIME) As String
' convert the FILETIME to LOCALTIME, then to SYSTEMTIME type
Dim ST As SYSTEMTIME
Dim LT As FILETIME
Dim t As Long
Dim ds As Double
Dim ts As Double
t = FileTimeToLocalFileTime(FT , LT)
t = FileTimeToSystemTime(LT, ST)
If t Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
ds = ds + ts
If ds > 0 Then
FileDate = Format$(ds, "mm/dd/yy hh:mm:ss")
Else
FileDate = "(no date)"
End If
End If
End Function
Sub main()
Dim ff As String
Const SOMEPATH As String = "c:\windows\"
ff = Dir$(SOMEPATH & "*.*", vbArchive)
Do While ff <> ""
ShowFileInfo SOMEPATH & ff
ff = Dir$()
Loop
End Sub
Private Sub ShowFileInfo(FullName As String)
' This subroutine demonstrates the technique
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim Created As String
Dim LastWrite As String
' FullName is the path and filename
' Substitute any valid file and path
hFile = FindFirstFile(FullName, WFD)
If hFile > 0 Then
Created = FileDate(WFD.ftCreationTim e)
MsgBox "File Created: " & Created, vbInformation, FullName
Else
MsgBox "File not found.", vbCritical, FullName
End If
End Sub
'32 bit Windows declarations
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 260
cAlternate As String * 14
End Type
Private Function FileDate(FT As FILETIME) As String
' convert the FILETIME to LOCALTIME, then to SYSTEMTIME type
Dim ST As SYSTEMTIME
Dim LT As FILETIME
Dim t As Long
Dim ds As Double
Dim ts As Double
t = FileTimeToLocalFileTime(FT
t = FileTimeToSystemTime(LT, ST)
If t Then
ds = DateSerial(ST.wYear, ST.wMonth, ST.wDay)
ts = TimeSerial(ST.wHour, ST.wMinute, ST.wSecond)
ds = ds + ts
If ds > 0 Then
FileDate = Format$(ds, "mm/dd/yy hh:mm:ss")
Else
FileDate = "(no date)"
End If
End If
End Function
Sub main()
Dim ff As String
Const SOMEPATH As String = "c:\windows\"
ff = Dir$(SOMEPATH & "*.*", vbArchive)
Do While ff <> ""
ShowFileInfo SOMEPATH & ff
ff = Dir$()
Loop
End Sub
Private Sub ShowFileInfo(FullName As String)
' This subroutine demonstrates the technique
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim Created As String
Dim LastWrite As String
' FullName is the path and filename
' Substitute any valid file and path
hFile = FindFirstFile(FullName, WFD)
If hFile > 0 Then
Created = FileDate(WFD.ftCreationTim
MsgBox "File Created: " & Created, vbInformation, FullName
Else
MsgBox "File not found.", vbCritical, FullName
End If
End Sub
oops, sorry, i forgot the name:
Private Sub ShowFileInfo(FullName As String)
' This subroutine demonstrates the technique
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim Created As String
Dim sname As String
Dim LastWrite As String
' FullName is the path and filename
' Substitute any valid file and path
hFile = FindFirstFile(FullName, WFD)
If hFile > 0 Then
Created = FileDate(WFD.ftCreationTim e)
sname = Left$(WFD.cFileName, InStr(1, WFD.cFileName, Chr$(0), vbTextCompare))
Debug.Print "File " & sname & "Created: " & Created, vbInformation, FullName
Else
MsgBox "File not found.", vbCritical, FullName
End If
End Sub
Private Sub ShowFileInfo(FullName As String)
' This subroutine demonstrates the technique
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
Dim Created As String
Dim sname As String
Dim LastWrite As String
' FullName is the path and filename
' Substitute any valid file and path
hFile = FindFirstFile(FullName, WFD)
If hFile > 0 Then
Created = FileDate(WFD.ftCreationTim
sname = Left$(WFD.cFileName, InStr(1, WFD.cFileName, Chr$(0), vbTextCompare))
Debug.Print "File " & sname & "Created: " & Created, vbInformation, FullName
Else
MsgBox "File not found.", vbCritical, FullName
End If
End Sub
ASKER
All the answers were good, however rapi you did answer first and I used your answer. Thanks all.
Maritimer
Maritimer
Dim fso As Object
Dim f As Object
Dim fc As Object
Dim vFile As File
Set fso = CreateObject("Scripting.Fi
Set f = fso.GetFolder("C:\Test")
For Each vFile In f.Files
Debug.Print vkey & vbTab & f.DateLastModified
Next
Also, f.DateCreated or f.DateLastAccessed could be used depending on what your requirements are.