Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datenimport aus verschiedener txt-files

Datenimport aus verschiedener txt-files
22.10.2008 15:11:00
günther
Hallo, habe das Problem, dass ich von allen .txt-Dateien eines Ordners den kompletten Inhalt in ein Tabellenblatt importieren möchte, um damit weiterzuarbeiten.
Also d.h. den Inhalt der ersten Datei importieren ab Zelle A3,
nach dem Inhalt der ersten Datei, 2-3 Leerzeilen,
darunter der Inhalt von Datei 2,
usw. bis datei 108 (die 65536 verfügbaren Zeilen reichen locker aus.)
hab hier mal den Code zum Import der ersten Datei

Sub Makro2()
' Makro2 Makro
With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\1\G-1.txt", _
Destination:=ActiveCell)
.Name = "G-1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Dieser Code zum Öffnender Datein, den ich hier im Forum fand, funktioniert gut, erstelt aber für jede Textdatei ein eigenees Tabellenblatt. Ich bräuchte aber den Inhalt aller txt-files auf einem Tabellenblatt, um mit Filter arbeiten zu können.


Sub Alle_Textdateien()
strExt = "*.txt"       'Dateiextension ggf. anpassen
ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (" & strExt & "), " & strExt,  _
Title:="Verzeichnisauswahl, erste Datei auswählen")
If ZuÖffnendeDatei = False Then Exit Sub
'Die ausgewählte Datei ist egal. es wird hier nur das Verzeichnis der Datei ausgewertet
strPath = CurDir & "\"
If strPath = "" Then
Exit Sub
Else
ChDir strPath
strFile = Dir(strPath & strExt) 'hier wird die erste Datei gefunden
Do While Len(strFile) > 0
Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, trailingMinusNumbers:=True
Sheets(1).Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'...weiter mit Änderungen an der Tabelle
strFile = Dir() ' nächste Datei
Loop
End If
End Sub


wäre schön, wenn jemand Rat weiß


1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenimport aus verschiedener txt-files
22.10.2008 17:52:35
fcs
Hallo Günther,
hier deine 2. Prozedur angepasst, so dass alle Daten in ein Tabellenblatt eingelesen werden.
Gruß
Franz

Sub Alle_Textdateien()
Dim strExt As String, strPath As String, strFile As String
Dim ZuÖffnendeDatei
Dim wb As Workbook, wksZiel As Worksheet
Dim rngDaten As Range, lngZeile As Long
strExt = "*.txt"       'Dateiextension ggf. anpassen
ZuÖffnendeDatei = Application.GetOpenFilename("Textdateien (" & strExt & "), " & strExt, _
Title:="Verzeichnisauswahl, erste Datei auswählen")
If ZuÖffnendeDatei = False Then Exit Sub
'Die ausgewählte Datei ist egal. es wird hier nur das Verzeichnis der Datei ausgewertet
strPath = CurDir & "\"
If strPath = "" Then
Exit Sub
Else
ChDir strPath
strFile = Dir(strPath & strExt) 'hier wird die erste Datei gefunden
'Leeres Tabellenblatt einfügen und als Ziel-Tabelle festlegen
ThisWorkbook.Worksheets.Add _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set wksZiel = ActiveSheet
lngZeile = 3 '1. Zeile ab der Daten in Zieltabelel eingefügt werden sollen
Application.ScreenUpdating = False
Do While Len(strFile) > 0
Workbooks.OpenText Filename:=strPath & strFile, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, trailingMinusNumbers:=True
Set wb = ActiveWorkbook
Set rngDaten = wb.Worksheets(1).UsedRange
rngDaten.Copy Destination:=wksZiel.Cells(lngZeile, 1)
lngZeile = lngZeile + rngDaten.Rows.Count + 2 '2 =Anzahl Leerzeilen zwischen  _
Dateien
wb.Close savechanges:=False
strFile = Dir() ' nächste Datei
Loop
Application.ScreenUpdating = True
MsgBox "Fertig"
End If
End Sub


Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige