|
'============================<
Funktionen >============================
Private Sub
fl_Aktualisieren_Liste_Files_Folder()
'------------<
fl_Aktualisieren_Liste_Files_Folder() >------------
'*ermitteln
der Dateien im Ordner und anzeigen
'< Init >
Dim sPfad_Ordner As String
sPfad_Ordner = tbxPfad_Ordner
'< Init
>
'< Korrekturen >
If sPfad_Ordner Like "" Or IsNull(sPfad_Ordner) Then sPfad_Ordner = "c:\"
sPfad_Ordner = Replace(sPfad_Ordner, "/", "\")
If Not Right(sPfad_Ordner, 1) Like "\" Then sPfad_Ordner = sPfad_Ordner & "\"
'</
Korrekturen >
On Error Resume Next
ctlListe_Import.RowSource = ""
'--<
Get_Folder >--
Dim objFileSystem As New FileSystemObject 'using Microsoft scripting Runtime
Dim objFolder As Folder
Set objFolder =
objFileSystem.GetFolder(sPfad_Ordner)
'<
Kontrolle : Ordner >
If Err.Number > 0 Then
'<
Standardordner >
addLog Err.Description
sPfad_Ordner = CurrentProject.Path
If Not Right(sPfad_Ordner, 1) Like "\" Then sPfad_Ordner = sPfad_Ordner & "\"
Set objFolder =
objFileSystem.GetFolder(sPfad_Ordner)
On Error GoTo 0
'</
Standardordner >
End If
If objFolder Is Nothing Then
Exit Sub
End If
'</
Kontrolle : Ordner >
'--</
Get_Folder >--
addStatus "check
files count:"
& objFolder.Files.Count
'----</
Files ermitteln >----
'<
List_Header >
ctlListe_Import.AddItem("Importstatus;File;FileDate;Date")
'</
List_Header >
'<
create_ado_Table >
Dim sorted_List As ADODB.Recordset
Set sorted_List = CreateObject("ADODB.Recordset")
sorted_List.CursorLocation = 3 ' adUseClient
sorted_List.Fields.Append
"Status",
200, 50 '
adVarChar
sorted_List.Fields.Append "FileName", 200, 50 ' adVarChar
sorted_List.Fields.Append "FileDate", 200, 50 ' adVarChar
sorted_List.Fields.Append "Date_Created", 7
' adDate
sorted_List.Open
'</
create_ado_Table >
On Error GoTo 0
Dim objFile As File
For Each objFile In objFolder.Files
Dim sFilename As String
sFilename = objFile.Name
' '< Filter >
' Dim sFilter As String
' sFilter = ctlFilter.Value
'
' Dim arrWords
' arrWords = Split(sFilter)
' '</ Filter >
Dim posExtension As Integer
posExtension = InStrRev(sFilename, ".")
Dim posStart As Integer
posStart = InStrRev(sFilename, "_", posExtension) + 1
Dim sFileDate As String
sFileDate = Mid(sFilename, posStart, posExtension - posStart)
Dim dtFile As String
dtFile = objFile.DateCreated
Dim sDateFile As String
sDateFile = objFile.DateCreated
If DateDiff("m", dtFile, Now) < 3 Then
If sFilename Like "*.csv*" Then
'---< ist_csv >---
If fl_Check_File_Is_Imported(sFilename) = False Then
'< not imported >
'< add_line >
sorted_List.AddNew
sorted_List("Status").Value = "_Neu"
sorted_List("FileName").Value = sFilename
sorted_List("FileDate").Value = sFileDate
sorted_List("Date_Created").Value = dtFile
sorted_List.Update
'</ add_line >
'ctlListe_Import.AddItem
("_neu;" & sFilename & ";" & sDateFile)
'</ not imported >
Else
'< is imported >
If optZeige_neue_Dateien = 0 Then
'< add_line >
sorted_List.AddNew
sorted_List("Status").Value = "_alt"
sorted_List("FileName").Value = sFilename
sorted_List("FileDate").Value = sFileDate
sorted_List("Date_Created").Value = dtFile
sorted_List.Update
'</ add_line >
'ctlListe_Import.AddItem
("alt;" & sFilename & ";" & sDateFile)
End If
'</ is imported >
End If
'---</ ist_csv >---
End If
End If
Next
'----<
Files ermitteln >----
'< sort
>
sorted_List.Sort = "[Status] ASC,[FileDate] DESC"
If Not sorted_List.EOF Then
sorted_List.MoveFirst
End If
'</
sort >
'--<
@Loop: Output >--
Do Until sorted_List.EOF
ctlListe_Import.AddItem sorted_List("Status") & ";" & sorted_List("FileName") & ";" & sorted_List("FileDate") & ";" & sorted_List("Date_Created")
sorted_List.MoveNext
Loop
'<
Abschluss >
Set objFileSystem = Nothing
Set objFile = Nothing
Set objFolder = Nothing
'</
Abschluss >
'------------</
fl_Aktualisieren_Liste_Files_Folder() >------------
End Sub
|