Das Datum ist komisch da nun versucht wurde mit getfiledate ein Datum von einem Ordner zu bekommen das geht wohl nicht. Ein END IF fehlte bzw war falsch nun bekomme ich zu den Files ein sinvolles Datum aber es sind immernoch Ordner dazwischen … wie filter ich diese raus ?
Das wurde mit
If (File „.“) And (File „…“) Then gemacht funktioniert aber nichtmehr
Hi Joe
ich habe mir jetzt mal das Original vorgenommen, außer dem
Button und der Liste alles entfernt und das Lesen des Datums
mit eingebaut. Irgend ein Fehlerchen ist noch drin, das Datum
wird für jedes Verzeichnis angezeigt, aber natürlich ein Wert,
der Unfug ist. Das bekommst Du aber selbst entfernt.
Option Explicit
Private Declare Function FindFirstFile Lib „kernel32“ _
Alias „FindFirstFileA“ (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib „kernel32“ _
Alias „FindNextFileA“ (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib „kernel32“ (ByVal _
hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private 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 Integer
End Type
Private Declare Function GetFileTime Lib „kernel32“ (ByVal _
hFile As Long, lpCreationTime As FILETIME, _
lpLastAccessTime As FILETIME, lpLastWriteTime _
As FILETIME) As Long
Const MAX_PATH As Long = 259&
Private 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 * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function CreateFile Lib „kernel32“ Alias
„CreateFileA“ _
(ByVal lpFileName As String, ByVal dwDesiredAccess As
Long, _
ByVal dwShareMode As Long, lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal _
dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long)
As Long
Private Declare Function FileTimeToSystemTime Lib „kernel32“ _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As
Long
Private Declare Function FileTimeToLocalFileTime Lib
„kernel32“ _
(lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As
Long
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FO_DELETE = &H3
Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Const FILE_ATTRIBUTE_READONLY As Long = &H1&
Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&
Private Sub Command1_Click()
Dim Files() As String
Dim X As Long
Dim Such As String
Dim DatCnt As Integer, DirCnt As Integer
Dim Max As Long
’ Ein Einfaches Suchmuster erstellen
Such = „*“
'If Left$(Such, 1) = „*“ Then Such = Right$(Such,
Len(Such) - InStr(Such, „.“))
ReDim Files(0 To 0)
’ Suchen
MousePointer = 11
DoEvents
Max = GetAllFiles(„C:\Programme\Microsoft Visual
Studio\VB98“, Such, Files)
MousePointer = 0
DoEvents
List1.Clear
’ Die Ergebnisse auflisten
List1.Visible = False
For X = 0 To Max - 1
List1.AddItem Files(X)
If Left$(Files(X), 2) = „>>“ Then
DirCnt = DirCnt + 1
Else
DatCnt = DatCnt + 1
End If
Next X
List1.Visible = True
End Sub
’ Durchsucht einen Ordner nach Dateien
’ Sollte der Ordner selbst nicht durchsucht werden können,
’ gibt die Funktion 0 zurück. Sonst wird die Anzahl der
Dateien zurückgegeben
Private Function GetAllFiles(ByVal Root As String, _
ByVal Such As String, ByRef Field() As String, _
Optional UsedField As Long = 0) As Long
Dim File As String
Dim hFile As Long
Dim FD As WIN32_FIND_DATA
Dim lngHandle As Long, SHDirOp As SHFILEOPSTRUCT, lngLong
As Long
Dim Ft1 As FILETIME, Ft2 As FILETIME, SysTime As
SYSTEMTIME
’ Evtl. Array vergrößern?
If (UsedField = UBound(Field)) Then
ReDim Preserve Field(UBound(Field) + 100)
End If
DoEvents
'Backslash ergänzen
If Right(Root, 1) „“ Then Root = Root & „“
’ Die erste Datei suchen
hFile = FindFirstFile(Root & „*.*“, FD)
’ Es konnte nichts gefunden werden
If hFile = 0 Then
GetAllFiles = 0
Exit Function
End If
’ Für jede Datei
Do
’ Den Dateinamen extrahieren
File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0))
’ Ist die Datei ein Verzeichnis?
If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
_
= FILE_ATTRIBUTE_DIRECTORY Then
’ . und … ignorieren
If (File „.“) And (File „…“)
Then
’ Unterordner auch durchsuchen?
’ Unterordner rekursiv erfassen
GetAllFiles = GetAllFiles +
GetAllFiles(Root & File, _
Such, Field, UsedField)
Else
’ Ergebnis speichern
’ Verzeichnis: „>>“ kann entfernt
werden,
’ da nur zur Visualisierung
Field(UsedField) = „>>“ & Root &
File
GetAllFiles = GetAllFiles + 1
UsedField = UsedField + 1
’ Evtl. Array vergrößern
If (UsedField = UBound(Field)) = 0 Then
ReDim Preserve Field(0 To
UBound(Field) + 100)
End If
End If
End If
’ Passt das Suchmuster?
If (Such Like Right$(UCase$(File), Len(Such))) Or
Such = „*“ Then
’ Ergebnis speichern
’ Datei: " " kann entfernt werden,
’ da nur zur Visualisierung
lngHandle = CreateFile(Root & File, GENERIC_WRITE,
FILE_SHARE_READ Or _
FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
GetFileTime lngHandle, Ft1, Ft1, Ft2
FileTimeToLocalFileTime Ft2, Ft1
FileTimeToSystemTime Ft1, SysTime
Field(UsedField) = " " & Root & File +
Str$(SysTime.wMonth) _
- „/“ + LTrim(Str$(SysTime.wDay)) + „/“ +
LTrim(Str$(SysTime.wYear))
GetAllFiles = GetAllFiles + 1
UsedField = UsedField + 1
’ Evtl. Array vergrößern
If (UsedField = UBound(Field)) Then
ReDim Preserve Field(0 To UBound(Field) +
100)
End If
End If
’ Nächste Datei suchen
Loop While FindNextFile(hFile, FD)
’ Suchhandle wieder freigeben - Suche beenden
Call FindClose(hFile)
End Function
Gruß, Rainer
