Excel, alle Ver­sio­nen

Prolog

In einem anderen kleinen Pro­jekt ist der ganz sim­ple Import von Text­dateien erar­beit­et wor­den. Manch­es von dem wer­den Sie hier auch wiederfind­en, denn die Grund­la­gen sind stets die gle­ichen. Hier, in diesem Pro­jekt, wird mehr Wert auf Sicher­heit und Kom­fort gelegt und das Wis­sen um den Umgang mit solchen Files ver­tieft.

Einstieg

Die (erste) Auf­gabe ist fol­gende: Alle Text­dateien mit der Dateina­menser­weiterung *.txt, welche in einem gegebe­nen Verze­ich­nis ste­hen, sollen in eine einzige Mappe importiert wer­den. Jede Text­datei wird in eine eigene Tabelle, in ein eigenes Sheet geschrieben wer­den. Spätestens bei fünf Text­dateien ist es wirk­lich lästig, das alles per Hand zu erledi­gen. Darum wird auch hier VBA-Code einge­set­zt, um die Arbeit zu erle­ichtern.

Einige Dinge allerd­ings wer­den nicht voll automa­tisiert. So ist es zwar denkbar, eine Nach­frage einzubauen, ob eine Kopfzeile mit den Über­schriften vorhan­den ist oder nicht, aber das wird bei diesem Mod­ell fest in den Code geschrieben und kann auch bei Bedarf leicht angepasst wer­den. Gle­ich­es gilt für den Pfad, wo auf Ihrem Rech­n­er (oder dem Serv­er) die Text­dateien gespe­ichert sind. Das Laufw­erk und das Unter­verze­ich­nis wer­den gleicher­maßen in den Code fest einge­tra­gen, wie auch die Dateinamen­er­weiterung *.txt. Sie wer­den das entsprechend anpassen müssen.

Natür­lich ist eine Abfrage mit hüb­schen Fen­stern mit etwas mehr Aufwand auch program­mierbar. Wenn Sie das vorhaben, acht­en Sie beim eventuellen Nach­schla­gen im Web unbe­­dingt auf die Excel-Ver­sion, da der Umgang mit Datei-Auswahl-Fen­stern bei neueren Excel-Ver­sio­nen in VBA kom­plett anders gehand­habt und pro­gram­miert wird.

Hin­weis: Bitte beacht­en Sie, dass die Dateip­fade in diesem Code auf meine eigene Arbeits­umgebung eingestellt sind. Sie wer­den in jedem Fall den Spe­icherort für die Text­dateien anpassen müssen. Und das Leerze­ichen in mein­er Pfadangabe ist kein Schreibfehler. Es sorgt dafür, dass dieser Ord­ner bei alpha­betis­ch­er Sortierung immer sehr weit oben ste­ht, meist sog­ar ganz oben 😉 .

▲ nach oben …

Import der Dateien

Zu Beginn erst ein­mal die Grund­form für den Import. Die Dat­en wer­den einzeln in eine Tabelle geschrieben, aber alle erst ein­mal in Spalte A. Die Tren­nung in einzelne Spal­ten erfol­gt (vor­erst noch) per Hand. In einem späteren Schritt wer­den dann auch die Spal­ten automa­tisch getren­nt.

Hin­weis: Voraus­set­zung für diese hier gecodete Form des Imports ist, dass die Dat­en mit einem Semi­kolon (Strich­punkt) getren­nt sind. Anführungsze­ichen um Texte sind OK, hier sog­ar gegeben. Und ein Semi­kolon inner­halb ein­er Textpas­sage zwis­chen den Anfüh­rungs­zeichen darf auch sein. Das unter­schei­det diese Ver­sion von der vorheri­gen, welche ganz zu Beginn dieses Beitrages schon ange­sprochen wor­den ist . – Dateien dieser Art wer­den gerne von „großen” Pro­gramm­paketen wie SAP oder Ora­cle erzeugt oder auch als neu­trales Import­for­mat ange­boten.

Aber auch andere Pro­gramme aus dem PC-Bere­ich kön­nen eigentlich immer im *.csv For­mat exportieren, und genau dieses For­mat liegt Ihnen hier vor. Auch wenn die Datei­namen­erweiterung *.txt lautet. – Und noch etwas ist wichtig, ja unverzicht­bar: Der Auf­bau der Dateien, also die Spal­tenzahl, ob mit oder ohne Über­schrift und der (logis­che) Inhalt der Spal­ten müssen gle­ich sein. Die Zeilen enthal­ten natür­lich ver­schiedene Werte, das ist klar.

In erster Lin­ie aus Grün­den des Daten­schutzes sind die Text-Dateien gepackt und mit einem Pass­wort verse­hen. Es han­delt sich zwar um ältere Dat­en, aber es sind echte Namen und Adressen, welche ich aus ein­er Tele­fon-CD exportiert habe. Laden Sie die auf unserem Serv­er bere­it gestellte Datei TelefonExport.zip hier herunter und ent­pack­en Sie die Datei­en in ein beliebiges Verze­ich­nis; vorzugsweise aber dort, wo Ihr Excel als erstes die Dateien sucht. Und ach ja, Ihr Rech­n­er „hängt” nicht beim herun­ter­laden. Die Datei ist fast 120 Kilo­Byte groß.

Bei der Nach­frage des Pass­wortes geben Sie bitte GMG-CC ein (acht­en Sie auf die Groß­schreibung). Soll­ten Sie aus welchen Grün­den auch immer keine *.zip-Dateien ent­pack­en kön­nen, dann senden wir Ihnen per Mail die reine Text­datei TelefonExport.txt. Die ist dann selb­stre­dend auch ohne Pass­wort. – Sie wun­dern sich über die Dateien­dung *.txt, obwohl es doch eine *.csv – Datei sein soll? Das hat mehrere Gründe. Ein­er davon ist, dass Excel davon genau so „irri­tiert” ist, wie Sie es gewiss waren. Eine *.csv wird Excel schon beim Import wegen der Dateien­dung anders behan­deln, darum dieses Täuschungs­man­över.  😎

▲ nach oben …

Der Code (Einstiegs – Version)

So, hier nun der Code der ersten Ver­sion dieses Abschnitts. Zugegeben, das ist schon erhe­blich aufwendi­ger als bei der sehr sim­plen Ver­sion aus dem Down­load-Bere­ich. Aber hier wird auch mehr importiert und auch mehr Wert auf Sicher­heit gelegt:

Option Explicit

Sub ImportAllTxt_1()
'Alle Textdateien eines Verzeichnisses in ein Workbook
'jede *.txt in 1 Tabelle. Einfachste Form
   Dim Pfad As String     'Dort liegen die Textfiles
   Dim aTxt()             'Anzahl der Textdateien
   Dim AnzSh As Integer   'Anzahl der Tabellenblätter
   Dim FullName As String 'Pfad + *.txt
   Dim txtName As String  'Name der Textdatei
   Dim AnzArr As Integer  'Anzahl der Array-Einträge
   Dim Sh2Del As Integer, Sh2Add As Integer  'Blätter löschen / zufügen
   Dim i As Integer, k As Integer
   Dim FFnr As Integer    'FreeFile-Nr.
   Dim TxtZeile As String, AnzSp As Integer
   Dim bolHeader As Boolean 'Überschrift in Textdatei(en)?
   Dim SchreibZeile As Long
   Dim Tx As String, CalcStatus as Long
   'Für einen Probelauf, um die Zeit des Abarbeitens festzustellen
   Dim Start As single, Ende As single
   
   Start = Timer
   With Application
      .ScreenUpdating = True
      CalcStatus = .Calculation
      .Calculation = xlCalculationManual
   End With
   On Error GoTo ErrorHandler
   
   'Alle Textdateien des Ordners in Array schreiben
   Pfad = "h:\ in Arbeit\TuT\Excel\TelefonExport\" 'Anpassen!
   FullName = Pfad & "*.txt"  'Evtl. anpassen auf *.csv, *.asc, ...
   AnzSh = Sheets.Count
   bolHeader = True  'Existiert eine Überschriftszeile
                     'bzw. soll auch keine zugefügt werden?
   ReDim aTxt(1)
   aTxt(1) = Dir(FullName)     'Erste Textdatei suchen
   If aTxt(1) > "" Then     'Gefunden
      aTxt(1) = Pfad & aTxt(1)'Vollen Pfad in Array schreiben
      Do
         txtName = Dir             'Weitere *.txt suchen
         If txtName > "" Then      'Gefunden
            AnzArr = UBound(aTxt) + 1  'Mehr Platz im Array schaffen
            ReDim Preserve aTxt(AnzArr)
            aTxt(AnzArr) = Pfad & txtName
         Else      'Rückgabe = "", alle *.txt gefunden
            Exit Do  'Schleife verlassen
         End If
      Loop
   End If
   
   'Textdateien einlesen und in getrennte Blätter speichern
   'Auf korrekte Anzahl Blätter prüfen / herstellen
   If AnzSh <> AnzArr Then  'Zu viele oder zu wenig Tabellenblätter
      If AnzSh < AnzArr Then  'Blätter zufügen
         Sh2Add = AnzArr - AnzSh
         Sheets.Add after:=Sheets(Sheets.Count), Count:=Sh2Add
      Else  'Blätter löschen
         Sh2Del = AnzSh - AnzArr
         If MsgBox("Achtung, es werden " & Sh2Del & " Blätter gelöscht", _
          vbYesNo + vbQuestion, "Warn-Hinweis") = vbYes Then
            'Die letzten Blätter löschen
            For i = AnzSh To AnzArr Step -1
               Sheets(i).Delete
            Next i
         Else  'Makro beenden
            MsgBox "Das Makro wird beendet, bei Bedarf neu starten!", _
            vbInformation, "Hinweis"
            Exit Sub
         End If 'MsgBox
      End If 'AnzSh <
   End If 'AnzSh <>
   
   AnzSh = Sheets.Count 'Wichtig, falls bislang <>,
                        'dann wurde der Wert nicht geändert
   'Alle Blätter -> bei Bedarf Inhalte leeren
   For i = 1 To AnzSh
      If Application.WorksheetFunction.CountA(Sheets(i).Cells) > 0 Then _
       Sheets(i).Cells.ClearContents
   Next i
   
   'Jede der Text-Dateien einlesen und in getrenntes Blatt schreiben
   'Die Daten werden nicht verknüpft sondern eingelesen und dann kopiert
   For i = 1 To AnzSh
      SchreibZeile = 1 + Abs(Not bolHeader)  'In Zeile 1 oder 2 schreiben?
      FFnr = FreeFile
      Open aTxt(i) For Input As #FFnr
      'Erst einmal alles in Spalte A schreiben
      Do While Not EOF(FFnr)       'Jede Text-Datei
         Line Input #FFnr, TxtZeile 'Zeilenweise lesen
         Sheets(i).Cells(SchreibZeile, 1) = TxtZeile  'In Tabelle schreiben
         SchreibZeile = SchreibZeile + 1
      Loop
      Close #FFnr
      Tx = aTxt(i)
   Next i 'Nächste Textdatei

ErrorHandler:
   If Err.Number <> 0 Then
      MsgBox "Fehler Nr.: " & Err.Number & vbCrLf _
       & Err.Description
   End If
   Close #FFnr
   With Application
      .ScreenUpdating = True
      .Calculate
      .Calculation = CalcStatus
   End With
   'Später diese Zeitmessung und -anzeige bitte löschen
   Ende = Timer
   MsgBox Ende - Start & " Sekunden"
End Sub

Manch­es ist in dem Code schon kom­men­tiert. Und spätestens jet­zt wer­den Sie erken­nen, dass Sie etwas Grund­ken­nt­nisse in VBA bzw. Pro­gram­mierung brauchen, wenn Sie das Pro­gramm ver­ste­hen wollen. Hin­weis: Im obi­gen Code sind einige Pas­sagen, die Sie anpassen können/sollten (z.B. *.txt zu *.csv) oder ändern müssen, wie den Pfad zu den Text­dateien. Und die Zeitmes­sung wer­den Sie auch rasch ent­fer­nen, wenn Sie für Ihre Arbeit­sumge­bung erkan­nt haben, ob Sie zwis­chen­durch eine Tasse Kaf­fee oder Tee trinken kön­nen oder nicht. Wahrschein­lich aber nicht …  😛

▲ nach oben …

Grund­sät­zlich wer­den Sie merken, dass ich reich­lich Vari­ablen ver­wende. Manch­es wäre auch so (direkt codiert) mach­bar, aber ich finde es angenehmer, wenn ich dank eines „sprechen­den” Vari­ablenna­mens rasch sehe, worum es geht. Und dass ich alle Vari­ablen am Anfang deklar­iere, das ist eine Frage des guten Stils. – Zu einzel­nen Pas­sagen will ich hier noch den einen oder anderen Kom­men­tar abgeben. In ein­er Schu­lung wird selb­stre­dend mehr dazu gesagt wer­den.

With Application 
  .ScreenUpdating = True
  .CalcStatus = .Calculation
  .Calculation = xlCalculationManual
End With
On Error GoTo ErrorHandler

Der Geschwindigkeit wegen wird der stetige Neu-Auf­bau des Bild­schirms und die Neu­be­rech­nung der Tabel­len­blät­ter aus­geschal­tet. Da im Falle eines Fehlers im Pro­gramm oder auch in den Text­dateien dieser Zus­tand wieder auf „Nor­mal” zurück geset­zt wer­den muss, ist eine Sprun­gadresse einge­fügt wor­den. Der Name ErrorHan­dler ist frei gewählt, wird aber gerne für dieses Sprungziel ver­wen­det, weil er inter­na­tion­al aus­sagekräftig ist.

'Alle Textdateien des Ordners in Array schreiben
Pfad = "h:\ in Arbeit\TuT\Excel\TelefonExport\" FullName = Pfad &
   "*.txt"
'Evtl. anpassen auf *.csv, *.asc, ...
AnzSh = Sheets.Count bolHeader = True
'Existiert eine Überschriftszeile bzw.
'soll auch keine zugefügt werden?

Den Inhalt der Vari­ablen Pfad wer­den Sie gewiss anpassen müssen, damit Ihre Text­dateien auch gefun­den wer­den. Auch die Dateinamen­er­weiterung ändern Sie bei Bedarf ab. Und ob in den zu importieren­den Dat­en eine Über­schrift existiert, das passen Sie in der Vari­ablen bol­Head­er an. Hat sie den Wert True, wird ein Mal die Über­schriftzeile gele­sen und in alle Ziel­blät­ter danach einge­fügt. Bei False wer­den alle Dat­en ab der ersten Zeile gele­sen und auch in der ersten Zeile des Sheets einge­fügt.

Der Rest des Codes ist recht gut kom­men­tiert. Bei Bedarf hil­ft Ihnen gewiss die VBA-Hil­fe, das Inter­net, Ihre Trainer­in, Ihr Train­er oder wir von GMG-CC weit­er.

▲ nach oben …

Automatische Trennung der Spalten

Derzeit ist es ja so, dass Sie die Aufteilung der Spalte A in die eigentlichen Zielspal­ten mit der Funk­tion­al­ität „Text in Spal­ten” vorgenom­men haben. Das lässt sich natür­lich auch per VBA automa­tisieren. Ver­schiedene Wege führen zum Ziel. Der ein­fach­ste ist gewiss, den Vor­gang ein Mal mit dem Recorder aufzuze­ich­nen:

Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), _
 DataType:=xlDelimited, _
 TextQualifier:=xlDoubleQuote, _ 
 ConsecutiveDelimiter:=False, _
 Tab:=False, Semicolon:=True, _
 Comma:=False, Space:=False, Other:=False, _
 FieldInfo:=Array(Array(1, 1), _
 Array(2, 1), _
 Array(3, 1), Array(4, 1), _
 Array(5, 1), Array(6, 1), _
 Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), _
 Array(11, 1), Array(12, 1), Array(13, 1), _
 Array(14, 1), _
 Array(15, 1), Array(16, 1)), _
 TrailingMinusNumbers:=True

Aha. Auch wenn der Code hier im Script etwas in Form gebracht wor­den ist, es bedarf schon einiges an Wis­sens­grund­lage, um das zu ver­ste­hen. – Da die kom­plette Spalte A markiert und entsprechend bear­beit­et wird, kön­nen Sie diesen Code für all diese Dateien auch ein­set­zen. Aber nur für diese. Denn es wird die Anzahl der Spal­ten zwar automa­tisch ermit­telt aber nicht in ein­er Vari­ablen abgelegt son­dern direkt umge­set­zt. Sie kön­nten diesen Code­block allen­falls für Dateien mit gle­ich­er Anzahl von Spal­ten und auch son­st iden­tis­chem Auf­bau ver­wen­den.

Das Ziel ist es ja, die Dat­en alle direkt in die Spal­ten zu schreiben. Und wenn wir schon ein­mal dabei sind, dann soll auch gle­ich jedes Tabel­len­blatt im Reg­is­ter (unten) den Namen der Datei bekom­men. Nur den Namen, ohne die Erweiterung „txt”, „csv”, „asc” oder was auch immer. Der endgültige Code sieht nun so aus:

Option Explicit Sub ImportAllTxt_1()
  'Alle Textdateiene eines Verzeichnisses in ein Workbook
  'jede *.txt in 1 Tabelle. Einfachste Form
  Dim Pfad As String 'Dort liegen die Textfiles
  Dim aTxt() 'Anzahl der Textdateien
  Dim AnzSh As Integer 'Anzahl der Tabellenblätter
  Dim FullName As String 'Pfad + *.txt
  Dim txtName As String 'Name der Textdatei
  Dim AnzArr As Integer 'Anzahl der Array-Einträge
  Dim Sh2Del As Integer, Sh2Add As Integer 'Blätter löschen / zufügen
  Dim i As Integer, k As Integer Dim FFnr As Integer 'FreeFile-Nr.
  Dim TxtZeile As String, AnzSp As Integer
  Dim bolHeader As Boolean 'Überschrift in Textdatei(en)?
  Dim SchreibZeile As Long
  Dim Tx As String 'Für einen Probelauf, um die Zeit des Abarbeitens festzustellen 
  Dim Start, Ende

  Start = Timer 
  With Application 
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With

  On Error GoTo ErrorHandler
  'Alle Textdateien des Ordners in Array schreiben
  Pfad = "h:\ in Arbeit\TuT\Excel\TelefonExport\" FullName = Pfad & "*.txt"
  'Evtl. anpassen auf *.csv, *.asc, ...
  AnzSh = Sheets.Count bolHeader = True 'Existiert eine Überschriftszeile bzw.
                                        'soll auch keine zugefügt werden?
  ReDim aTxt(1) aTxt(1) = Dir(FullName) 'Erste Textdatei suchen
  If aTxt(1) > "" Then 'Gefunden
    aTxt(1) = Pfad & aTxt(1)'Vollen Pfad in Array schreiben
    Do
      txtName = Dir  'Weitere *.txt suchen
      If txtName > "" Then 'Gefunden
        AnzArr = UBound(aTxt) + 1
        'Mehr Platz im Array schaffen
        ReDim Preserve aTxt(AnzArr) aTxt(AnzArr) = Pfad & txtName
      Else 'Rückgabe = "", alle *.txt gefunden
        Exit Do 'Schleife verlassen
      End If
    Loop
  End If

  'Textdateien einlesen und in getrennte Blätter speichern
  'Auf korrekte Anzahl Blätter prüfen / herstellen
  If AnzSh <> AnzArr Then  'Zu viele oder zu wenig Tabellenblätter
    If AnzSh < AnzArr Then 'Blätter zufügen
      Sh2Add = AnzArr - AnzSh Sheets.Add after:=Sheets(Sheets.Count), Count:=Sh2Add
    Else 'Blätter löschen
      Sh2Del = AnzSh - AnzArr
      If MsgBox("Achtung, es werden " & Sh2Del & " Blätter gelöscht", _
       vbYesNo + vbQuestion, "Warn-Hinweis") = vbYes Then 'Die letzten Blätter löschen
        For i = AnzSh To AnzArr Step -1
          Sheets(i).Delete
        Next i
      Else 'Makro beenden
        MsgBox "Das Makro wird beendet, bei Bedarf neu starten!", _
         vbInformation, "Hinweis"
        Exit Sub
      End If'MsgBox
    End If'AnzSh <
  End If 'AnzSh <>
  AnzSh = Sheets.Count 'Wichtig, falls bislang <> wurde der Wert nicht geändert
                       'Alle Blätter -> bei Bedarf Inhalte leeren
  For i = 1 To AnzSh
    If Application.WorksheetFunction.CountA(Sheets(i).Cells) > 0 Then _
     Sheets(i).Cells.ClearContents
  Next i

  'Jede der Text-Dateien einlesen und in getrenntes Blatt schreiben
  'Die Daten werden nicht verknüpft sondern eingelesen und dann kopiert
  For i = 1 To AnzSh SchreibZeile = 1 + Abs(Not bolHeader) 'In Zeile 1 oder 2 schreiben?
                                                           'Anzahl der "Spalten" im Textfile
    FFnr = FreeFile 
    Open aTxt(i) For Input As #FFnr 'Textdatein zum lesen öffnen
    Line Input #FFnr, TxtZeile 'Erste Zeile lesen
    AnzSp = UBound(Split(TxtZeile, ";")) + 1 'Indirekt die Spalten zählen
    Close #FFnr 'Text-Datei wieder schließen

    FFnr = FreeFile
    Open aTxt(i) For Input As #FFnr 'i hat immer noch den Wert 1!
    'Erst einmal alles in Spalte A schreiben
    Do While Not EOF(FFnr) 'Jede Text-Datei
      Line Input #FFnr, TxtZeile 'Zeilenweise lesen
      Sheets(i).Cells(SchreibZeile, 1) = TxtZeile 'In Tabelle schreiben
      SchreibZeile = SchreibZeile + 1
    Loop  'In Spalten aufteilen 
    Sheets(i).Columns("A:A").TextToColumns _
     Destination:=Range("A" & 1 + Abs(Not bolHeader)), _
     DataType:=xlDelimited, _
     TextQualifier:=xlDoubleQuote, _
     Semicolon:=True, _
     FieldInfo:=Array(Array(AnzSp, 1))
    Close #FFnr
    Tx = aTxt(i)
    Sheets(i).Name = myFileName(Tx, True)
  Next i 'Nächste Textdatei

ErrorHandler:
  If Err.Number <> 0 Then
    MsgBox "Fehler Nr.: " & Err.Number & vbCrLf _
     & Err.Description
  End If
  Close #FFnr
  With Application
    .ScreenUpdating = True
    .Calculate 
    .Calculation = CalcStatus
  End With

  'Später bitte löschen
  Ende = Timer MsgBox Ende - Start & " Sekunden"
End Sub

Function myFileName(Pfad As String, Optional kuerzen As Boolean) As String
  Dim lastBS As Integer
  Dim i As Integer
  Dim Rc As Variant

  Pfad = Trim(Pfad) 'Vorsichtshalber
  Rc = Right(Pfad, Len(Pfad) - InStrRev(Pfad, "\"))
  If kuerzen Then Rc = Left(Rc, InStrRev(Rc, ".") - 1)
    myFileName = Rc
    'Falls in älteren VBA-Versionen 'InStrRev' noch nicht verfügbar ist, dann
    'löschen Sie die beiden Programmzeilen hierüber und aktivieren Sie
    'den hierunter auskommentierten Code stattdessen.
    '#
    'For i = Len(Pfad) To 1 Step -1
    'If Mid(Pfad, i, 1) = "\" Then Exit For
    'Next i
    'Rc = Trim(Mid(Pfad, i + 1, 999))
    'If kuerzen Then
    'For i = Len(Rc) To 1 Step -1
    'If Mid(Rc, i, 1) = "." Then Exit For
    'Next i
    'Rc = Left(Rc, Len(Rc) - i)
    'End If
    'myFileName = Rc
    '#
End Function

Zur Func­tion myFile­Name noch ein Hin­weis: Nicht alle VBA-Ver­sio­nen ken­nen die Funk­tion InStr­Rev, wom­it das erste Auftreten eines Zeichens in einem String von rechts aus gese­hen berech­net wird. Das ist hier ganz prak­tisch, weil im Pfad ja mehrere „\” enthal­ten sind und Sie nur die Posi­tion des let­zten Back­slash brauchen. – Falls also der VBA-Com­pil­er „meck­ert”, dann kom­men­tieren Sie den oberen Teil aus und löschen Sie die Kom­men­tierung im unteren Bere­ich, wo mit etwas mehr Aufwand der gle­ich Zweck erfüllt wird.

Lassen Sie das ein­fach ein­mal auf sich wirken. Und pro­bieren Sie es aus. Es läuft. Manch­es ließe sich „schlanker” pro­gram­mieren oder vielle­icht auch effek­tiv­er, aber hier geht es in erster Lin­ie darum, dass das Pro­gramm läuft, dass es das erfüllt, was es soll und dass Sie (unter Umstän­den mit etwas Hil­fe) weitest­ge­hend ver­ste­hen, was da wann und warum geschieht.

Diese let­zte Ver­sion des Codes kön­nen Sie hier als *.zip-Datei, welche die Klassendatei (*.cls) und die Text­datei (*.txt) enthält herunter laden.

Option Explicit

Sub ImportAllTxt_1()
'Alle Textdateien eines Verzeichnisses in ein Workbook
'jede *.txt in 1 Tabelle. Einfachste Form
  Dim Pfad As String 'Dort liegen die Textfiles
  Dim aTxt() 'Anzahl der Textdateien
  Dim AnzSh As Integer
   'Anzahl der Tabellenblätter
  Dim FullName As String 'Pfad + *.txt
  Dim txtName As String 'Name der Textdatei
  Dim AnzArr As Integer 'Anzahl der Array-Einträge
  Dim Sh2Del As Integer, Sh2Add As Integer 'Blätter löschen / zufügen
  Dim i As Integer, k As Integer
  Dim FFnr As Integer 'FreeFile-Nr.
  Dim TxtZeile As String, AnzSp As Integer
  Dim bolHeader As Boolean 'Überschrift in Textdatei(en)?
  Dim SchreibZeile As Long
  Dim Tx As String 'Für einen Probelauf, um die Zeit des Abarbeitens festzustellen
  Dim Start, Ende

  Start = Timer
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationManual
  End With

  On Error GoTo ErrorHandler
  'Alle Textdateien des Ordners in Array schreiben
  Pfad = "h:\ in Arbeit\TuT\Excel\TelefonExport\" FullName = Pfad & "*.txt"
  'Evtl. anpassen auf *.csv, *.asc, ...
  AnzSh = Sheets.Count
  bolHeader = True
  'Existiert eine Überschriftszeile
  'bzw. soll auch keine zugefügt werden?
  ReDim aTxt(1)
  aTxt(1) = Dir(FullName) 'Erste Textdatei suchen
  If aTxt(1) > "" Then 'Gefunden
    aTxt(1) = Pfad & aTxt(1) 'Vollen Pfad in Array schreiben
    Do
      txtName = Dir  'Weitere *.txt suchen
      If txtName > "" Then  'Gefunden
        AnzArr = UBound(aTxt) + 1
        'Mehr Platz im Array schaffen
        ReDim Preserve aTxt(AnzArr)
        aTxt(AnzArr) = Pfad & txtName
      Else  'Rückgabe = "", alle *.txt gefunden
        Exit Do 'Schleife verlassen
      End If
    Loop
  End If

  'Textdateien einlesen und in getrennte Blätter speichern
  'Auf korrekte Anzahl Blätter prüfen / herstellen
  If AnzSh <> AnzArr Then 'Zu viele oder zu wenig Tabellenblätter
    If AnzSh < AnzArr Then 'Blätter zufügen
      Sh2Add = AnzArr - AnzSh Sheets.Add after:=Sheets(Sheets.Count), Count:=Sh2Add
    Else 'Blätter löschen
      Sh2Del = AnzSh - AnzArr
      If MsgBox("Achtung, es werden " & Sh2Del & " Blätter gelöscht", _
       vbYesNo + vbQuestion, "Warn-Hinweis") = vbYes Then
       'Die letzten Blätter löschen
        For i = AnzSh To AnzArr Step -1
          Sheets(i).Delete
        Next i
      Else 'Makro beenden
        MsgBox "Das Makro wird beendet, bei Bedarf neu starten!", _
         vbInformation, "Hinweis"
        Exit Sub
      End If 'MsgBox
    End If 'AnzSh <
  End If 'AnzSh <>
  AnzSh = Sheets.Count

  'Wichtig, falls bislang <>,
  'dann wurde der Wert nicht geändert
  'Alle Blätter -> bei Bedarf Inhalte leeren
  For i = 1 To AnzSh
    If Application.WorksheetFunction.CountA(Sheets(i).Cells) > 0 Then _
     Sheets(i).Cells.ClearContents
  Next i

  'Jede der Text-Dateien einlesen und in getrenntes Blatt schreiben
  'Die Daten werden nicht verknüpft sondern eingelesen und dann kopiert
  For i = 1 To AnzSh SchreibZeile = 1 + Abs(Not bolHeader)
  'In Zeile 1 oder 2 schreiben?
    FFnr = FreeFile Open aTxt(i) For Input As #FFnr 'Erst einmal alles in Spalte A schreiben
    Do While Not EOF(FFnr) 'Jede Text-Datei
      Line Input #FFnr, TxtZeile 'Zeilenweise lesen
      Sheets(i).Cells(SchreibZeile, 1) = TxtZeile 'In Tabelle schreiben
      SchreibZeile = SchreibZeile + 1
    Loop
    Close #FFnr
    Tx = aTxt(i)
  Next i 'Nächste Textdatei

ErrorHandler:
  If Err.Number <> 0 Then
    MsgBox "Fehler Nr.: " & Err.Number & vbCrLf _
     & Err.Description
  End If
  Close #FFnr

  With Application
    .ScreenUpdating = True
    .Calculate
    .Calculation = CalcStatus
  End With

  'Später bitte löschen, da nur zur Zeitkontrolle
  Ende = Timer MsgBox Ende - Start & " Sekunden"
End Sub

▲ nach oben …

Import n:1, mehrere Textdateien in 1 Tabellenblatt

Bish­er haben Sie erar­beit­et, wie mehrere externe Text­dateien in ein (1) Work­book, also eine Arbeitsmappe importiert wer­den, jede Text­datei in ein getren­ntes Tabel­len­blatt. Hier geht es darum, dass Sie wiederum mehrere Text­dateien, welche eine beliebige Endung haben kön­nen, in ein einziges Tabel­len­blatt importieren. Da die meis­ten „großen” Pro­gramme (SAP, Ora­cle, …) für den Excel-les­baren Export das *.csv-For­mat nutzen, ist dieses For­mat als Stan­dard­vertreter für den Import einge­set­zt wor­den. Im Code haben wir die in Deutsch­land üblichen Semi­ko­la und nicht die Kom­mas als Feldtren­ner ver­wen­det.

Was auf den ersten Blick aussieht wie eine kleine Änderung am bish­er ver­wen­de­ten Code kann doch für ungeübte Pro­gram­mier­er eine kleine Her­aus­forderung darstellen. Es reicht näm­lich nicht, ein­fach nur die Code-Zeilen zu ent­fer­nen, welche für den Wech­sel in ein neues Arbeits­blatt und dessen Namensge­bung ver­ant­wortlich sind. Es muss auch dafür gesorgt wer­den, dass die Zeile mit den Über­schriften nur ein Mal ganz zu Beginn ein­ge­le­sen und dann bei jed­er weit­eren Text­datei über­sprun­gen wird.

Weit­er­hin haben wir noch einige Kleinigkeit­en im Ablauf verbessert. So ist jet­zt beispiel­sweise die Dateinamen­er­weiterung der zu importieren­den Dateien in ein­er Vari­ablen fest­gelegt. Und wir haben auch noch eine kleine Prüfrou­tine einge­baut, falls in dem gewählten Verze­ich­nis keine Datei mit der fest­gelegten Endung enthal­ten ist. Es bleibt aber dabei, dass stets alle im benan­nten Ord­ner enthal­te­nen Files mit der vorgegebe­nen Endung importiert wer­den.

Damit Sie sich mehr auf das Wesentliche konzen­tri­eren kön­nen, haben wir für Sie eine Excel-Datei mit dem Code vor­bere­it­et. Laden Sie dieses File von unserem Serv­er herunter und öff­nen Sie per AltF11 den VBA-Edi­tor. Das ist wichtig, weil Sie in jedem Fall den Pfad anpassen müssen, wo die zu importieren­den Dateien liegen. Und vielle­icht auch den Suf­fix, falls es keine *.csv sein soll. Diese Änderun­gen nehmen Sie hier vor:

'Alle Textdateien des Ordners in Array schreiben
Pfad = "D:\E-I-S\DataImport\csv_nTo1\Data\"
Suffix = "*.csv" 

Aus gutem Grund haben wir auch hier auf die Datei-Auswahl per Datei-Auswahlfen­ster (File-Open-Dia­log) verzichtet. Erstens gibt es je nach Excel-Ver­sion zwei grundle­gend ver­schiedene Typen, die auch nicht untere­inan­der kom­pat­i­bel sind und zweit­ens soll das hier nicht im Mit­telpunkt ste­hen. Das ist einem anderen Beitrag, den wir gewiss später erstellen wer­den, vor­be­hal­ten.

Der fol­gende Code sorgt dafür, dass mit Semi­ko­la getren­nte Felder ein­er Text­datei kor­rekt in Spal­ten aufgeteilt wer­den:

'In Spalten aufteilen
'Hier sind u.U. Anpassungen erforderlich! (Semikolon, etc)
'Nutzen Sie erforderlichenfalls dem Makrorecorder
.Columns("A:A").TextToColumns _
 Destination:=Range("A" & 1 + Abs(Not bolHeader)), _
 DataType:=xlDelimited, _
 TextQualifier:=xlDoubleQuote, _
 Semicolon:=True, _
 FieldInfo:=Array(Array(AnzSp, 1))
'und Spaltenbreiten auf AutoBreite setzen
.Range(Columns(1), Columns(AnzSp))
.EntireColumn.AutoFit

Bei der Gele­gen­heit wer­den die einzel­nen Spal­ten des Imports auch gle­ich auf die opti­male Spal­tenbre­ite eingestellt. – Sie wer­den natür­lich zu Beginn mit Test­dat­en arbeit­en. Es soll­ten auch nicht all zu viele Einzelfiles und auch Daten­sätze sein, damit Sie eine bessere Kon­trollmöglichkeit haben. Dazu kommt auch, dass Sie ein Gefühl für den Zeitaufwand bekom­men. Das Ganze kann schon etwas länger dauern. Sie wer­den so auch nicht so rasch an einen „Hänger” denken, wenn bei sehr großen Daten­men­gen (viele Files, viele Zeilen) importieren. Nur aus diesem Grund haben wir noch die Zeitmes­sung im Code belassen. Wenn Sie etwas Erfahrung mit dem Importver­hal­ten gesam­melt haben, dann wer­den Sie selb­stre­dend diese Option auskom­men­tieren oder ganz ent­fer­nen.