VBA Problem 2
21.01.2004 15:51:14
Thorsten
Hatte das Problem vorhin schon einmal geschildert und Ralf hatte mir auch nen Tip gegeben, den ich leider, aus Mangel an VBA Kenntnissen, nicht anwenden kann. Vielleicht weiß jemand, wie man das einbaut. Nur kurz zur erklärung: Es geht darum, dass ich daten aus mehreren Textdateien in eine tabelle schreiben lassen möchte. Das Problem: Er schreibt mi nur die Daten der letzten Datei. Er überschreibt die anderen. Hier mal der Code: Vielleicht weiß jemand was. Bitte mit Beispiel oder etwas in der Art. Ich absoluter VBA Laie.
Danke für die Hilfe
Sub TextImport()
Application.DisplayAlerts = False
Dim iRow As Integer, iCol As Integer
Dim sFile As String, sTxt As String
Dim datei As String
iRow = 1
iCol = 1
Sheets("Ergebnis").Range("A:ZZ").ClearContents
datei = Dir("C:\Test\*.txt")
Do While datei <> ""
sFile = "C:\Test\" + datei
On Error Resume Next
Close
Open sFile For Input As #1
Do Until EOF(1)
Line Input #1, sTxt
Do While InStr(sTxt, "|")
Cells(iRow, iCol).Value = Left(sTxt, InStr(sTxt, "|") - 1)
sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, "|"))
iCol = iCol + 1
Loop
Cells(iRow, iCol).Value = sTxt
iRow = iRow + 1
iCol = 1
Loop
Close
Application.ScreenUpdating = False
With Range("A1")
.AutoFilter Field:=4, Criteria1:="trans*"
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Ergebnis").Range("A1")
End With
Sheets("Ergebnis").Range("A:C,E:J").ClearContents
Range("D1:D1000").Select
Worksheets("Ergebnis").Activate
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1))
datei = Dir
Sheets("Tabelle1").Range("A:Z").ClearContents
Loop
End Sub