AW: Macro zur Auswertung von .txt Dateien
13.09.2007 17:20:12
.txt
Hallo Sven,
hier ein Beispiel für eine Text Datei mit 4 Feldern.
Mit dem aufgezeichneten Makro hast bereits den Teil-Code, den du für das Öffnen brauchst, um den Array...-Wirrwarr zu ergänzen.
Für das Übertragen der Daten aus dem geöffneten TXT-Tabellenblatt in das Listenblatt muss du für je Spalten den passenden Case-Fall nachtragen.
Gruß
Franz
Sub TXT_DATEN_importieren()
' TXT_DATEN_importieren Makro
Dim strVerz$, lngZeile&, txtDatei$, wks As Worksheet
Dim iI%, wbquelle As Workbook, wksQuelle As Worksheet
Set wks = ActiveSheet ' Tabelle in der Daten eingefügt werden ggf. Anpassen
lngZeile = 2 'Startzeile zum Einfügen
strVerz = "C:\Lokale Daten\Test\Test_Test" ' Anpassen!!
txtDatei = Dir(strVerz & "\*.txt")
Application.ScreenUpdating = False
Do Until txtDatei = ""
Workbooks.OpenText Filename:=strVerz & "\" & txtDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 2), Array(4, 2)), TrailingMinusNumbers:=True
Set wbquelle = ActiveWorkbook
Set wksQuelle = wbquelle.Worksheets(1)
With wks
For iI = 1 To wksQuelle.Cells(1, wksQuelle.Columns.Count).End(xlToLeft).Column
Select Case iI
Case 1, 2 'boolsche Einträge für Checkboxen
.Cells(lngZeile, iI).Value = _
IIf(wksQuelle.Cells(1, iI).Value = 0, False, True)
Case 3 'Texteingabe
.Cells(lngZeile, iI).Value = wksQuelle.Cells(1, iI).Value
Case 4 'Zahleneingabe Double
.Cells(lngZeile, iI).Value = _
CDbl(wksQuelle.Cells(1, iI).Value)
Case 999 'Zahleneingabe Integer
.Cells(lngZeile, iI).Value = _
CInt(wksQuelle.Cells(1, iI).Value)
Case 998 'Datum-/Zeiteingabe
.Cells(lngZeile, iI).Value = _
CDate(wksQuelle.Cells(1, iI).Value)
Case Else
MsgBox "Sie haben vergessen für ein Formularfeld eine Case-Anweisung festzulegen!"
End Select
Next
End With
lngZeile = lngZeile + 1
wbquelle.Close savechanges:=flase
txtDatei = Dir
Loop
Application.ScreenUpdating = True
End Sub