ich stehe vor einem Problem und weiß mir nicht zu helfen.
Würde mich über Hilfe freuen.
ich habe eine Userform erstellt mit u.a zwei datumsfeldern.
Start und End Datum.
Als Start Datum z.b "15.01.2009 06:30:00"
Als End Datum z.b "17.01.2009 18:30:00"
Jetzt habe ich in meinen Laufwerken verschiedene ordner mit meheren Tausend Dateien.
Habe schon eine Optimierte such Routine die aber trotzdem noch sehr lange braucht um alle Dateien zu suchen und mir in meine Tabelle zu schreiben.(Ich glaube es wird auch in Ordnern gesucht die nicht durchsucht werden müssen weil in diesen Ordnern diese Datums nicht vorkommen können)
Ich habe Folgende Ordner struktur:
Also Beispiel.
R:\Safe\ZXR\Result\ML03\Data\Stat_1\FUTT\2009\02\02\20
Dieser Ordner enthält Dateien von der Zeit:
Jahr = 2009
Monat = Februar
Tag = "2" Tag im Monat
Stunde = "20" Uhr
in diesem Ordner sind Datein in diesem Format. (Zahl am Anfang geändert)
"0006xx220555126666627_13_090_2009_02_02_20_12_24.dat"
Diese Dateiname sollen gefunden werden.
Diese Datei ist entstanden z.b am
Jahr = 2009
Monat = Februar
Tag = "2" Tag im Monat
Stunde = "20" Uhr
Minute = "12"
Sekunde = "24"
Also Datum 02.02.2009 20:12:24"
die nächste Datei kann so aussehen.
"0006xx220555126666627_13_090_2009_05_02_24_12_34.dat"
Jahr = 2009
Monat = Mai
Tag = "2" Tag im Monat
Stunde = "24" Uhr
Minute = "12"
Sekunde = "34"
Wie kann ich diese suche Optimieren(beschleunigen) ?
Ich weiß es ist viel verlangt aber vielleicht geht es irgend wie schneller.
So dauert die suche manchmal über 10 Minuten.
danke an alle Helfer !!!
Momentan suche ich So:
'In Einem Modul
VonDatum = frm_main.cbo_Datum_von & " " & frm_main.tb_stunde_von & ":" & frm_main.tb_minute_von & ":00"
'VonDatum z.b SO VonDatum = 18.01.2009 06:15:00
BisDatum = frm_main.cbo_Datum_bis & " " & frm_main.tb_stunde_bis & ":" & frm_main.tb_minute_bis & ":00"
'BisDatum z.b SO VonDatum = 19.01.2009 08:30:00
'Hier wird das suchen aufgerufen
Pfad, VonDatum, BisDatum, Dateiformat, mit Unterordner, kompl. Pfad u. Datei
ListFilesInFolder sGrundPfad, VonDatum, BisDatum, "*_20##_##_##_##_##_##.dat", True, True
Sub ListFilesInFolder(SourceFolderName As String, DatumVon As Date, DatumBis As Date, Optional DateiFormat As String = "*.*", Optional IncludeSubfolders As Boolean = False, Optional FolderName As Boolean = False)
Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Dim FileName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo Err_Zugriff: 'sollte Ordener geschützt sein
If DatumOrdner(DatumVon, DatumBis, SourceFolderName) Then
For Each FileItem In SourceFolder.Files
If LCase(FileItem) Like LCase(DateiFormat) Then
FileName = Right$(FileItem, Len(FileItem) - InStrRev(FileItem, "\"))
If FunctionDatum(FileName) >= DatumVon And FunctionDatum(FileName) 'Einfügen der Daten in Tabelle
ErsteZelle.Value = IIf(False, FileItem, FileName) 'False = Nur Dateiname ausgeben
ErsteZelle.Offset(rowOffset:=0, columnOffset:=2).Value = FunctionDatum(FileName)
Set ErsteZelle = ErsteZelle.Offset(1, 0)
'Einfügen der daten in Listbox
'frm_main.ListBox1.AddItem IIf(False, FileItem, FileName) 'False = Nur Dateiname ausgeben
End If
End If
Next FileItem
End If
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, DatumVon, DatumBis, DateiFormat, IncludeSubfolders, FolderName
Next SubFolder
End If
Err_Zugriff:
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Function FunctionDatum(strText As String) As Date
Dim strT As String
On Error Resume Next
strT = Left(Right(strText, 23), 19)
FunctionDatum = CDate(Replace(Left(strT, 10), "_", "-") & _
" " & Replace(Right(strT, 8), "_", ":"))
End Function
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function DatumOrdner(DatumVon As Date, DatumBis As Date, sPfad As String) As Boolean
Dim Datum As Date, stempPfad As String, sDatum As String
stempPfad = Replace(sPfad, sGrundPfad, "")
If Len(stempPfad)
DatumOrdner = False
Exit Function
Else
stempPfad = Left$(stempPfad, 11)
stempPfad = Right$(stempPfad, Len(stempPfad) - 1)
sDatum = Right$(stempPfad, 2) & "."
sDatum = sDatum & Mid$(stempPfad, 6, 2) & "."
sDatum = sDatum & Left$(stempPfad, 4)
Datum = CDate(sDatum)
If Datum >= Int(DatumVon) And Datum
DatumOrdner = True
Exit Function
End If
End If
DatumOrdner = False
End Function