Warum wird nicht alles korrekt eingelesen?
10.08.2013 11:38:22
Pascal
Vor langer Zeit schon mal wurde mir hier im Forum geholfen, den untenstehenden Code zusammenzubasteln.
Es geht um folgendes:
Mittels untenstehendem Code werden Textfiles eingelesen und daraus Fehlermeldungen gesucht und aufbereitet.
Folgendes file als Beispiel wird eingelesen:
https://www.herber.de/bbs/user/86789.txt
In diesem File drin (Protokoll aus einem SAP-Datenexport) sind Zeilen drin, die mit "Aufteiler" beginnen.
Genau diese Zeilen sind Fehler, welche im Excel aufbereitet werden sollen.
wenn ich den folgenden Code laufen lasse, so werden diese Fehler ausgelesen.
Warum aber werden nicht alle Zeilen aus dem Textfile (die mit "Aufteiler") beginnen ins Excel übertragen ?
Wo liegt der Fehler?
Besten Dank für Eure Hilfe!
Sub DateiImport()
Dim varDatei, strText As String, arrTemp As Variant, intI As Integer
Dim intFF As Integer, wks As Worksheet, lngZeile As Long, intLine As Integer
Dim strSp1$, strSp2$, strSp3$, strSp4$, strSp5$
Dim Zeile As Long 'Variable um Zeile mit "Generierungsprotokoll" auszulesen und dann zu lö _
schen inkl. der nächsten beiden folgenden Zeilen
Dim strTXT_File As String, sInhalt As String 'Variablendeklaration für Bearbeitung Textfile _
vor Import
Dim F As Integer 'Variablendeklaration für Bearbeitung Textfile vor Import
Dim oldStatus As String
oldStatus = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "BITTE HABEN SIE EINEN MOMENT GEDULD ! DIE DATEN WERDEN AUFBEREITET" _
strTXT_File = Application.GetOpenFilename(Filefilter:="Texte(*.txt),*.txt", Title:="Bitte _
Datendatei öffnen")
F = FreeFile
'Lese TXT
Open strTXT_File For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
'Schreibe TXT
Open strTXT_File For Output As #F
Print #F, sInhalt
Close #F
'____________________________________________________________________________________________________
Sheets("Tabelle2").Select 'leeres Tabellenblatt "Tabelle 2" wählen
'Textdatei auswählen
varDatei = strTXT_File
If varDatei = False Then Exit Sub
Set wks = ActiveSheet
lngZeile = 1
With wks
'Spaltentitel eintragen
.Cells(lngZeile, 1) = "Aufteiler"
.Cells(lngZeile, 2) = "Position"
.Cells(lngZeile, 3) = "Bestellposition für: Artikel"
.Cells(lngZeile, 4) = "Betrieb"
.Cells(lngZeile, 5) = "Sonstiges"
'Spalten formatieren
.Range(.Columns(1), .Columns(5)).VerticalAlignment = xlVAlignTop
.Range(.Columns(1), .Columns(4)).AutoFit
.Columns(5).ColumnWidth = 40
.Columns(5).WrapText = True
End With
intFF = FreeFile()
Open varDatei For Input As #intFF
Do Until EOF(intFF)
Line Input #intFF, strText
If Left(strText, 9) = "Aufteiler" Then 'Zeile 1 aufbereiten
arrTemp = Split(strText, ",")
strSp1 = Trim(arrTemp(0))
strSp2 = Trim(arrTemp(1))
strSp5 = ""
intLine = 1
ElseIf Left(strText, 8) = "Bestellp" Then 'Zeile 2 aufbereiten
arrTemp = Split(strText, ",")
strSp3 = Trim(arrTemp(0))
strSp4 = Left(Trim(arrTemp(1)), 13)
strSp5 = Trim(Mid(arrTemp(1), 1))
strSp5 = VBA.Replace(strSp5, "wurde nicht ange", "wurde nicht angelegt ", 1)
intLine = 2
Else 'Zeile 3 + 4 aufbereiten
strSp5 = strSp5 & strText
intLine = intLine + 1
End If
If intLine = 4 Then '4. Zeile des Datensatzes ist eingelesen
'Daten in Tabelle schreiben
lngZeile = lngZeile + 1
With wks
'führende Nullen bleiben erhalten
.Cells(lngZeile, 1) = "'" & VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = "'" & VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = "'" & VBA.Replace(strSp3, "Bestellposition für: Artikel: ", "", 1) _
.Cells(lngZeile, 4) = "'" & VBA.Replace(strSp4, "Betrieb: ", "", 1)
.Cells(lngZeile, 5) = strSp5
'oder ohne führende Nullen
.Cells(lngZeile, 1) = VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = VBA.Replace(strSp3, "Bestellposition für: Artikel: ", "", 1)
.Cells(lngZeile, 4) = VBA.Replace(strSp4, "Betrieb: ", "", 1)
.Cells(lngZeile, 5) = strSp5
End With
End If
Loop
Close #intFF
'Autofit / Zellenformatierung der Tabelle in Excel:
Rows("1:1").Select
Selection.Font.Bold = True
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Cells.Select
Selection.NumberFormat = "0_ ;[Red]-0 "
Range("A1").Select
'fertig aufbereitete Daten aus Tabellenblatt 2 (Aktive Arbeitsmappe) in neue Arbeitsmappe rü _
berkopieren
Cells.Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
End Sub