Bitte um Hilfe! Text-Dateien auslesen

Hallo Zusammen,
ich versuche gerade mehrere Textdateien aus einem Ordner (variabel) in ein Tabellenblatt einzuladen.
Der Ordner soll über ein Explorerähnliches Fenster selektiert werden.
Im Ordner selbst befinden sich neben txt-Dateien auch png & jpg's.
Wie schaffe ich es, dass nur die txt-Dateien aus dem Ordner ausgelesen werden?
Vielleicht könnt Ihr mir weiterhelfen? :) Danke

Sub MehrereTextdateienInTabelleEinlesen1() Dim strDatei As String Tabelle1.Rows.Clear Zeile = 1 Dim Pfad As String With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\" .Title = "Ordnerauswahl" .ButtonName = "Auswahl..." .InitialView = msoFileDialogViewList If .Show = -1 Then Pfad = .SelectedItems(1) If Right(Pfad, 1) "\" Then Pfad = Pfad & "\" Else Pfad = "" End If End With If Pfad = "" Then MsgBox ("Kein Ordner gewählt!") Else MsgBox Pfad If Pfad = "" Then Exit Sub 'MsgBox Pfad strDatei = Dir(Pfad & "/") Do While strDatei "" Workbooks.OpenText Filename:=Pfad & "/" & strDatei, _ DataType:=xlDelimited, semicolon:=True, local:=True Set Quelle = ActiveWorkbook Quelle.Worksheets(1).UsedRange.Copy Destination:=Tabelle1.Cells(Zeile, 1) Quelle.Close savechanges:=False strDatei = Dir Zeile = Tabelle1.UsedRange.Rows.Count + 1 Loop 'AutoFit für Spalten herstellen Tabelle1.Columns.AutoFit End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
ich hab mal ein paar Fehler rausgenommen:

Option Explicit

Public Sub MehrereTextdateienInTabelleEinlesen1()
    Dim strDatei As String, Pfad As String
    Dim Zeile As Long
    Dim Quelle As Workbook

    Tabelle1.Cells.Clear
    Zeile = 1

    '---------------------------

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Ordnerauswahl"
        .ButtonName = "Auswahl..."
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            Pfad = .SelectedItems(1) & "\"
        Else
            MsgBox ("Kein Ordner gewählt!")
            Exit Sub
        End If
    End With

    MsgBox Pfad

    '------------------------

    strDatei = Dir$(Pfad & "*.txt")

    Do Until strDatei = ""

        Workbooks.OpenText Filename:=Pfad & strDatei, _
            DataType:=xlDelimited, semicolon:=True, local:=True

        Set Quelle = ActiveWorkbook
        Quelle.Worksheets(1).UsedRange.Copy Destination:=Tabelle1.Cells(Zeile, 1)
        Quelle.Close savechanges:=False
        strDatei = Dir$
        Zeile = Tabelle1.UsedRange.Rows.Count + 1
    Loop

    'AutoFit für Spalten herstellen
    Tabelle1.Columns.AutoFit

End Sub

Gruß
Nepumuk

sFiles = Application.GetOpenFilename("csv-Dateien (*.csv),*.csv", MultiSelect:=True) If IsArray(sFiles) Then Debug.Print LBound(sFiles), UBound(sFiles) 'als Beispiel für die erste Kontrolle For Each ar In sFiles next ar

Beliebteste Forumthreads (12 Monate)

Bitte um Hilfe! Text-Dateien auslesen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread