dtpicker zur Auswertung nutzen
09.10.2017 09:41:42
Manuela
ich bin letzte Woche leider erfolglos gewesen. Dies ist der Beitrag:
https://www.herber.de/cgi-bin/callthread.pl?index=1584331
Ich habe eine Auswertung die mir aus den txt Dateien die Zeile mit dem ERROR auflistet.
Da in den Ordener sehr viele Dateien sind, möchte ich anhand von dem dtpicker eine Auswärtung nur in dem Zeitraum ausführen.
Das Datum vom dtpicker steht auf I8 und I9.
Wie kann ich die Aufforderung rein bringen, das nur die txt Dateien in dem dtpicker Zeitraum eingelesen werden soll ?
Der wichtige Teil vom Code in "fett".
Mein Code:
Sub findWordinTXT()
Dim sWord As String, sPath As String, sSearchPath As String, FileName As String, InputData
Dim AnzFound As Integer
AnzFound = 0
On Error GoTo Fehler
'Blattschutz entfernen damit M11 gelöscht werden kann (Performance)
ActiveSheet.Unprotect
Range("M11").ClearContents
'Wort nach dem gesucht werden soll
sWord = "Error"
sSearchPath = "L:\" & [J11] & "\*txt"
sPath = "L:\" & [J11] & "\"
FileName = Dir(sSearchPath)
If FileName "" Then
Do While FileName ""
Open sPath & FileName For Input As #1
Do While Not EOF(1)
Line Input #1, InputData
If InStr(1, InputData, sWord) > 0 Then
'Zeile mit Suchwort gefunden
AnzFound = AnzFound + 1
Sheets("Analyse_Alle").Cells(AnzFound, 1) = FileName
Sheets("Analyse_Alle").Cells(AnzFound, 2) = InputData
End If
Loop
Close #1
'nächste Datei (loop)
FileName = Dir
Loop
End If
'Spaltierung der Zeile B
Range("B1:B100000").TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(22, 1), Array(28, 1), Array(42, 1), Array(42, 1), Array(55, 1), _
_
_
Array(79, 1), Array(90, 1)), TrailingMinusNumbers:=True
'Filter setzen
Range("A1:I1").AutoFilter
'Formel Setzen (Performance)
Range("M11").FormulaArray = _
"=SUM(IF(R[-10]C[-12]:R[989]C[-12]"""",1/COUNTIF(R[-10]C[-12]:R[989]C[-12],R[-10]C[-12]:R[ _
_
989]C[-12])))"
ActiveSheet.Protect userinterfaceonly:=True
ActiveSheet.EnableAutoFilter = True
Exit Sub
Fehler:
MsgBox "Keine Variante Ausgewählt." & vbNewLine & "Oder es wurden keine Daten dazu gefunden. _
_
", _
vbInformation, "Dateiauswahl!"
End Sub
Gruß
Manuela