Mehrere txt-Dateien in eine Tabelle bekommen?

Computer: Software & Programmierung Office Software
1

Hallo
ich habe eine größere Anzahl an txt Dateien.
Wenn ich diese Einzeln in Excel öffne dann ist
die erste Zeile belegt und der Rest leer.

Nun möchte ich die 20 txt Dateien gleich zeitig öffnen und
eine Tabelle mit so 20 Zeilen haben.

Kann ich in Excel mehrere Dateien in eine Tabelle schreiben?

Vielen Dank
Daniel

2

Kann ich in Excel mehrere Dateien in eine Tabelle schreiben?

Menü -> Daten -> Externe Daten importieren -> Speicherort auswählen -> Trennzeichen festlegen -> und schließlich 1. Zelle auswählen

Beim 1. Mal eben A1, dann A2 uswusf.

Gruss
Stefan

3

Hi Daniel,

Kann ich in Excel mehrere Dateien in eine Tabelle schreiben?

was soll die Tabelle denn anschließend zeigen - ein Inhaltsverzeichnis? Das geht nicht, indem 20 Dateien geöffnet werden, sondern indem Du ein Inhaltsverzeichnis (zB mit cmd > dir) erstellst und das importierst.

Gruß Ralf

4

Hallo Daniel,

der folgende code ermöglicht über einen Dialog das Quellverzeichnis auszuwählen. Aus allen dort vorhandenen txt.Dateien mit dem Dateinamen „x*.txt“ werden die Daten der Zellen „A1:E1“ ausgelesen und untereinander in dieses Arbeitsblatt untereinander kopiert. Die Anzahl der Dateien spielt dabei keine Rolle. Dateinamen und Spaltenanzahl evtl. ändern.

versuch’s mal hiermit (dazu den code in ein modul einfügen):

Public Type BROWSEINFO
 hOwner As Long
 pidlRoot As Long
 pszDisplayName As String
 lpszTitle As String
 ulFlags As Long
 lpfn As Long
 lParam As Long
 iImage As Long
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" \_
 Alias "SHGetPathFromIDListA" \_
 (ByVal pidl As Long, ByVal pszPath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" \_
 Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg As String) As String
 Dim bInfo As BROWSEINFO
 Dim Path As String
 Dim r As Long, x As Long, pos As Integer
 bInfo.pidlRoot = 0&
 If IsMissing(Msg) Then
 bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
 Else
 bInfo.lpszTitle = Msg
 End If
 bInfo.ulFlags = &H1
 x = SHBrowseForFolder(bInfo)
 Path = Space$(512)
 r = SHGetPathFromIDList(ByVal x, ByVal Path)
 If r Then
 pos = InStr(Path, Chr$(0))
 GetDirectory = Left(Path, pos - 1)
 Else
 GetDirectory = ""
 End If
End Function

Function FileArray(strPath As String, strPattern As String)
 Dim arrDateien()
 Dim intCounter As Integer
 Dim strDatei As String
 If Right(strPath, 1) "\" Then strPath = strPath & "\"
 strDatei = Dir(strPath & strPattern)
 Do While strDatei ""
 intCounter = intCounter + 1
 ReDim Preserve arrDateien(1 To intCounter)
 arrDateien(intCounter) = strDatei
 strDatei = Dir()
 Loop
 FileArray = arrDateien
End Function

Sub DatenImport()
 Dim arrFiles As Variant
 Dim intCounter As Integer, intRow As Integer
 Dim strPath As String
 Application.ScreenUpdating = False
 strPath = GetDirectory("Bitte Pfad der Quelldateien auswählen:")
 If strPath = "" Then Exit Sub
 arrFiles = FileArray(strPath, "x\*.txt")
 intRow = 1
 For intCounter = 1 To UBound(arrFiles)
 Workbooks.Open strPath & "\" & arrFiles(intCounter)
 Range("A1:E1").Copy ThisWorkbook.Worksheets(1).Cells(intRow, 1)
 ActiveWorkbook.Close savechanges:=False
 intRow = intRow + 1
 Next intCounter
End Sub

Gruß
Maria

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]