Mehrere txt Dateien in eine Excel-Tabelle nebeneinander importieren - VBA Code o.ä.

Question

Hallo zusammen,
ich habe folgendes Problem:

Ich habe sehr viele txt Dateien, die je 2 Spalten haben

Wenn ich das manuell importiere, benötige ich folgende Einstellungen im
Konvertierungsassistent:
Schritt 1:
Wählen Sie den Dateityp, der Ihre Daten am besten beschreibt? -> getrennt
Import beginnen in Zeile 1
Dateiursprung MS-Cos (PC-8)

Schritt 2:
Trennzeichen festlegen: bei Tabstopp und Komma einen Haken setzen
Textqualifiziere *

Schritt 3:
Datenformat der Spalten: Standard
Weitere: Bei numerischen Daten verwendete Trennzeichen:
Dezimal: Punkt
1000er: Komma

Daten importtieren:
Format: Tabelle
Wo einfügen? -> bestehendes Arbeitsblatt =$A$1

Dann klicke ich auf OK und alles super, ABER wie geht das mit einem VBA Code?
Das würde mir sehr viel Arbeit ersparen :-)

Ich hoffe mir kann jemand helfen! Ich danke euch jetzt schon mal!

Answer 1

Hallo  Skipper17

Ein Beispiel!

Gruss Nighty

Importiert alle txt Dateien eines angegebenen Verzeichnisses
Fortlaufend zur ersten freien Spalte

Deine Eigenschaften solltest du mit einer Makroaufnahme ermitteln
Die zu ersetzenden Eigenschaften im Code von bis,sind durch Kommentare abgegrenzt,zu ersetzen bzw zu ergänzen

[code]Sub Txt_Import()
    Dim DateiName As String, Dpfad As String, Dendung As String
    Dim SpX As Long
    Dendung = "*.txt"
    Dpfad = OrdnerAuswahl
    DateiName = Dir(Dpfad & Dendung)
    Do While DateiName <> ""
        SpX = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
        If SpX > 1 Then SpX = SpX + 1
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dpfad & DateiName, Destination:=Cells(1, SpX))
            .Name = Mid(DateiName, 1, InStrRev(DateiName, ".") - 1)
            'Eigenschaften Anfang
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = xlWindows
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
            .Refresh BackgroundQuery:=False
            'Eigenschaften Ende
        End With
        DateiName = Dir
    Loop
End Sub[/code]
[code]Function OrdnerAuswahl() As String
    On Error GoTo FehlerRoutine
    Dim AppShell As Object
    Dim BrowseDir As Variant
    Set AppShell = CreateObject("Shell.Application")
    Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
    OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function[/code]