AW: Daten aus Textdatei
27.04.2018 14:45:42
UweD
Hallo
nach ähnlichem Prinzip...
Wieder undetestet
Sub Dateiliste()
Dim objFileSearch As clsFileSearch
Dim lngIndex As Long, lngTemp As Long
Dim varOutput As Variant, varTemp() As Variant, varValue As Variant
Dim strPath As String
Dim FF As Integer
'***
Dim CloseFind As String, OpenFind As String, PosFind As Integer, TimeFind As Date
OpenFind = ";Opened;" 'ohne Leerzeichen
CloseFind = ";Closed; " 'mit Leerzeichen
'***
strPath = "C:\PIXARGUS_NEU\Backup_Logs\Einzelauswertung" & Cells(1, 2).Value & "\"
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
Call Range(Cells(2, 1), Cells(Rows.Count, 4)).ClearContents
Set objFileSearch = New clsFileSearch
With objFileSearch
.NewSearch = True
.CaseSenstiv = True
.Extension = "*.log"
.FolderPath = strPath
.SearchLike = "*.*"
.SubFolders = True
If .Execute(Sort_by_Date_Create, Sort_Order_Descending) > 0 Then
Redim varOutput(1 To .FileCount, 1 To 4)
For lngIndex = 1 To .FileCount
lngTemp = 0
Erase varTemp
varOutput(lngIndex, 1) = .Files(lngIndex).FI_FileName
'varOutput(lngIndex, 2) = .Files(lngIndex).FI_LastModify
'varOutput(lngIndex, 3) = .Files(lngIndex).FI_DateCreate
FF = FreeFile
Open .Files(lngIndex).FI_FullName For Input As #FF
Do While Not EOF(FF)
Redim Preserve varTemp(lngTemp)
Line Input #FF, varTemp(lngTemp)
'***
PosFind = InStr(varTemp(lngTemp), OpenFind)
If PosFind > 0 Then
TimeFind = CDate(Mid(Replace(varTemp(lngTemp), ";", " "), PosFind + Len(OpenFind) + 1))
varOutput(lngIndex, 3) = TimeFind
End If
PosFind = InStr(varTemp(lngTemp), CloseFind)
If PosFind > 0 Then
TimeFind = CDate(Mid(Replace(varTemp(lngTemp), ";", " "), PosFind + Len(CloseFind) + 1))
varOutput(lngIndex, 2) = TimeFind
End If
'***
lngTemp = lngTemp + 1
Loop
Close #FF
If Ubound(varTemp) > 3 Then
If InStr(1, varTemp(Ubound(varTemp) - 3), ";") > 0 Then
varValue = Split(varTemp(Ubound(varTemp) - 3), ";")
If Ubound(varValue) > 3 Then
varOutput(lngIndex, 4) = varValue(4)
End If
End If
End If
Next
End If
End With
Range("A2").Resize(Ubound(varOutput, 1), 4) = varOutput
Set objFileSearch = Nothing
End Sub
Spalte auch TT.MM.JJJJ hh:mm:ss formatieren
LG UweD