mehrere Textdateien in Excel importieren
maschin
ich bin neu hier und arbeite mit Excel nur gelegentlich und mit Makros und VBS kenne ich mich nicht aus.
Ich habe Text Dateien (sind alle im gleichen Ordner) die alle gleich aufgebaut sind, die Daten sind mit tab getrennt und belegen mehrere Zeilen.
Der zweite Code von Seite http://www.office-loesung.de/ftopic422775_0_0_asc.php paßt sehr gut für meine Zwecke, nur sollte in der Exceltabelle die importierten Daten (Zahlen zwischen 0 und 999, sowie ein paar Wörter) von jeder Datei nur eine Zeile belegen.
Mit diesem Code werden sie in der Exceltabelle auf mehrere Zeilen verteilt, genau so wie sie in den Text Dateien aussehen.
Demo einer Text Datei:
82 88 88 555 0 0 0 0 0 10 20
9 89 456 566 56 56 56 56 65 0
87 65 987 65 20 0 0 0 0 0 0
Und so sollte es dann in der Exceldatei aussehen:
82 88 88 555 0 0 0 0 0 10 20 9 89 456 566 56 56 56 56 65 0 87 65 987 65 20 0 0 0 0 0 0
Was muss hier geändert werden?
Vielen Dank für Eure Hilfe.
Sub test()
Dim strPfad As String
Dim FSO As Object
Dim file
Dim lngLR As Long
'Anpassen
strPfad = "C:\...\"
Set FSO = CreateObject("scripting.filesystemobject")
For Each file In FSO.getfolder(strPfad).Files
strFileName = file.Name
'Anpassen (Die 1 in cells(...,1) steht für die Spalte A
'Wenn angepasst werden muss dann den Buchstabe (z.B. A zu B) verändern und Zahl verä _
ndern (dann 1 zu 2)
strDestination = "A" & Cells(Rows.Count, 1).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strPfad & strFileName, Destination:=Range( _
strDestination))
.Name = "Uebersicht" 'Name des Tabellenblattes nach Import
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
'Hier kannst du das Trennzeichen einstellen (Leerzeichen ist eingestellt)
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
End Sub