Textdateien importieren (2)

Text-Import, komplett und ausführlich diskutiert

Excel, alle Versionen

Prolog

In einem anderen kleinen Projekt ist der ganz simple Import von Textdateien erarbeitet worden. Manches von dem werden Sie hier auch wiederfinden, denn die Grundlagen sind stets die gleichen. Hier, in diesem Projekt, wird mehr Wert auf Sicherheit und Komfort gelegt und das Wissen um den Umgang mit solchen Files vertieft.

Einstieg

Die (erste) Aufgabe ist folgende: Alle Textdateien mit der Dateinamenserweiterung *.txt, welche in einem gegebenen Verzeichnis stehen, sollen in eine einzige Mappe importiert wer­den. Jede Textdatei wird in eine eigene Tabelle, in ein eigenes Sheet geschrieben wer­den. Spätestens bei fünf Textdateien ist es wirklich lästig, das alles per Hand zu erledigen. Darum wird auch hier VBA-Code eingesetzt, um die Arbeit zu erleichtern.

Einige Dinge allerdings werden nicht voll automatisiert. So ist es zwar denkbar, eine Nach­frage einzubauen, ob eine Kopfzeile mit den Überschriften vorhanden ist oder nicht, aber das wird bei diesem Modell fest in den Code geschrieben und kann auch bei Bedarf leicht angepasst werden. Gleiches gilt für den Pfad, wo auf Ihrem Rechner (oder dem Server) die Textdateien gespeichert sind. Das Laufwerk und das Unterverzeichnis werden gleicher­maßen in den Code fest eingetragen, wie auch die Dateinamenerweiterung *.txt. Sie werden das entsprechend anpassen müssen.

Natürlich ist eine Abfrage mit hübschen Fenstern mit etwas mehr Aufwand auch program­mierbar. Wenn Sie das vorhaben, achten Sie beim eventuellen Nachschlagen im Web unbe­­dingt auf die Excel-Version, da der Umgang mit Datei-Auswahl-Fenstern bei neueren Excel-Versionen in VBA komplett anders gehandhabt und programmiert wird.

Hinweis: Bitte beachten Sie, dass die Dateipfade in diesem Code auf meine eigene Arbeits­umgebung eingestellt sind. Sie werden in jedem Fall den Speicherort für die Textdateien anpassen müssen. Und das Leerzeichen in meiner Pfadangabe ist kein Schreibfehler. Es sorgt dafür, dass dieser Ordner bei alphabetischer Sortierung immer sehr weit oben steht, meist sogar ganz oben 😉 .

▲ nach oben …

Import der Dateien

Zu Beginn erst einmal die Grundform für den Import. Die Daten werden einzeln in eine Tabelle geschrieben, aber alle erst einmal in Spalte A. Die Trennung in einzelne Spalten erfolgt (vorerst noch) per Hand. In einem späteren Schritt werden dann auch die Spalten automatisch getrennt.

Hinweis: Voraussetzung für diese hier gecodete Form des Imports ist, dass die Daten mit einem Semikolon (Strichpunkt) getrennt sind. Anführungszeichen um Texte sind OK, hier sogar gegeben. Und ein Semikolon innerhalb einer Textpassage zwischen den Anfüh­rungs­zeichen darf auch sein. Das unterscheidet diese Version von der vorherigen, welche ganz zu Beginn dieses Beitrages schon angesprochen worden ist . – Dateien dieser Art wer­den gerne von „großen“ Programmpaketen wie SAP oder Oracle erzeugt oder auch als neutrales Importformat angeboten.

Aber auch andere Programme aus dem PC-Bereich können eigentlich immer im *.csv For­mat exportieren, und genau dieses Format liegt Ihnen hier vor. Auch wenn die Datei­namen­erweiterung *.txt lautet. – Und noch etwas ist wichtig, ja unverzichtbar: Der Auf­bau der Dateien, also die Spaltenzahl, ob mit oder ohne Überschrift und der (logische) Inhalt der Spalten müssen gleich sein. Die Zeilen enthalten natürlich verschiedene Werte, das ist klar.

In erster Linie aus Gründen des Datenschutzes sind die Text-Dateien gepackt und mit einem Passwort versehen. Es handelt sich zwar um ältere Daten, aber es sind echte Namen und Adressen, welche ich aus einer Telefon-CD exportiert habe. Laden Sie die auf unserem Server bereit gestellte Datei TelefonExport.zip hier herunter und entpacken Sie die Datei­en in ein beliebiges Verzeichnis; vorzugsweise aber dort, wo Ihr Excel als erstes die Dateien sucht. Und ach ja, Ihr Rechner „hängt“ nicht beim herunterladen. Die Datei ist fast 120 KiloByte groß.

Bei der Nachfrage des Passwortes geben Sie bitte GMG-CC ein (achten Sie auf die Groß­schreibung). Sollten Sie aus welchen Gründen auch immer keine *.zip-Dateien entpacken können, dann senden wir Ihnen per Mail die reine Textdatei TelefonExport.txt. Die ist dann selbstredend auch ohne Passwort. – Sie wundern sich über die Dateiendung *.txt, obwohl es doch eine *.csv – Datei sein soll? Das hat mehrere Gründe. Einer davon ist, dass Excel davon genau so „irritiert“ ist, wie Sie es gewiss waren. Eine *.csv wird Excel schon beim Import wegen der Dateiendung anders behandeln, darum dieses Täuschungsmanöver.  😎

▲ nach oben …

Der Code (Einstiegs – Version)

So, hier nun der Code der ersten Version dieses Abschnitts. Zugegeben, das ist schon erheblich aufwendiger als bei der sehr simplen Version aus dem Download-Bereich. Aber hier wird auch mehr importiert und auch mehr Wert auf Sicherheit 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

Manches ist in dem Code schon kommentiert. Und spätestens jetzt werden Sie erkennen, dass Sie etwas Grundkenntnisse in VBA bzw. Programmierung brauchen, wenn Sie das Programm verstehen wollen. Hinweis: Im obigen Code sind einige Passagen, die Sie anpassen können/sollten (z.B. *.txt zu *.csv) oder ändern müssen, wie den Pfad zu den Textdateien. Und die Zeitmessung werden Sie auch rasch entfernen, wenn Sie für Ihre Arbeitsumgebung erkannt haben, ob Sie zwischendurch eine Tasse Kaffee oder Tee trinken können oder nicht. Wahrscheinlich aber nicht …  😛

▲ nach oben …

Grundsätzlich werden Sie merken, dass ich reichlich Variablen verwende. Manches wäre auch so (direkt codiert) machbar, aber ich finde es angenehmer, wenn ich dank eines „sprechenden“ Variablennamens rasch sehe, worum es geht. Und dass ich alle Variablen am Anfang deklariere, das ist eine Frage des guten Stils. – Zu einzelnen Passagen will ich hier noch den einen oder anderen Kommentar abgeben. In einer Schulung wird selbstredend mehr dazu gesagt werden.

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

Der Geschwindigkeit wegen wird der stetige Neu-Aufbau des Bildschirms und die Neu­be­rech­nung der Tabellenblätter ausgeschaltet. Da im Falle eines Fehlers im Programm oder auch in den Textdateien dieser Zustand wieder auf „Normal“ zurück gesetzt werden muss, ist eine Sprungadresse eingefügt worden. Der Name ErrorHandler ist frei gewählt, wird aber gerne für dieses Sprungziel verwendet, weil er international aussagekrä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 Variablen Pfad werden Sie gewiss anpassen müssen, damit Ihre Text­dateien auch gefunden werden. Auch die Dateinamenerweiterung ändern Sie bei Bedarf ab. Und ob in den zu importierenden Daten eine Überschrift existiert, das passen Sie in der Variablen bolHeader an. Hat sie den Wert True, wird ein Mal die Überschriftzeile gelesen und in alle Zielblätter danach eingefügt. Bei False werden alle Daten ab der ersten Zeile gelesen und auch in der ersten Zeile des Sheets eingefügt.

Der Rest des Codes ist recht gut kommentiert. Bei Bedarf hilft Ihnen gewiss die VBA-Hilfe, das Internet, Ihre Trainerin, Ihr Trainer oder wir von GMG-CC weiter.

▲ nach oben …

Automatische Trennung der Spalten

Derzeit ist es ja so, dass Sie die Aufteilung der Spalte A in die eigentlichen Zielspalten mit der Funktionalität „Text in Spalten“ vorgenommen haben. Das lässt sich natürlich auch per VBA automatisieren. Verschiedene Wege führen zum Ziel. Der einfachste ist gewiss, den Vorgang ein Mal mit dem Recorder aufzuzeichnen:

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 worden ist, es bedarf schon einiges an Wissensgrundlage, um das zu verstehen. – Da die komplette Spalte A markiert und entsprechend bearbeitet wird, können Sie diesen Code für all diese Dateien auch einsetzen. Aber nur für diese. Denn es wird die Anzahl der Spalten zwar automatisch ermittelt aber nicht in einer Variablen abgelegt sondern direkt umgesetzt. Sie könnten diesen Codeblock allenfalls für Dateien mit gleicher Anzahl von Spalten und auch sonst identischem Aufbau verwenden.

Das Ziel ist es ja, die Daten alle direkt in die Spalten zu schreiben. Und wenn wir schon einmal dabei sind, dann soll auch gleich jedes Tabellenblatt im Register (unten) den Namen der Datei bekommen. 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 Function myFileName noch ein Hinweis: Nicht alle VBA-Versionen kennen die Funktion InStrRev, womit das erste Auftreten eines Zeichens in einem String von rechts aus gesehen berechnet wird. Das ist hier ganz praktisch, weil im Pfad ja mehrere „\“ enthalten sind und Sie nur die Position des letzten Backslash brauchen. – Falls also der VBA-Compiler „meckert“, dann kommentieren Sie den oberen Teil aus und löschen Sie die Kommentierung im unteren Bereich, wo mit etwas mehr Aufwand der gleich Zweck erfüllt wird.

Lassen Sie das einfach einmal auf sich wirken. Und probieren Sie es aus. Es läuft. Manches ließe sich „schlanker“ programmieren oder vielleicht auch effektiver, aber hier geht es in erster Linie darum, dass das Programm läuft, dass es das erfüllt, was es soll und dass Sie (unter Umständen mit etwas Hilfe) weitestgehend verstehen, was da wann und warum geschieht.

Diese letzte Version des Codes können Sie hier als *.zip-Datei, welche die Klassendatei (*.cls) und die Textdatei (*.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

Bisher haben Sie erarbeitet, wie mehrere externe Textdateien in ein (1) Workbook, also eine Arbeitsmappe importiert werden, jede Textdatei in ein getrenntes Tabellenblatt. Hier geht es darum, dass Sie wiederum mehrere Textdateien, welche eine beliebige Endung haben können, in ein einziges Tabellenblatt importieren. Da die meisten „großen“ Programme (SAP, Oracle, …) für den Excel-lesbaren Export das *.csv-Format nutzen, ist dieses Format als Standardvertreter für den Import eingesetzt worden. Im Code haben wir die in Deutschland üblichen Semikola und nicht die Kommas als Feldtrenner verwendet.

Was auf den ersten Blick aussieht wie eine kleine Änderung am bisher verwendeten Code kann doch für ungeübte Programmierer eine kleine Herausforderung darstellen. Es reicht nämlich nicht, einfach nur die Code-Zeilen zu entfernen, welche für den Wechsel in ein neues Arbeitsblatt und dessen Namensgebung verantwortlich sind. Es muss auch dafür gesorgt werden, dass die Zeile mit den Überschriften nur ein Mal ganz zu Beginn eingelesen und dann bei jeder weiteren Textdatei übersprungen wird.

Weiterhin haben wir noch einige Kleinigkeiten im Ablauf verbessert. So ist jetzt beispielsweise die Dateinamenerweiterung der zu importierenden Dateien in einer Variablen festgelegt. Und wir haben auch noch eine kleine Prüfroutine eingebaut, falls in dem gewählten Verzeichnis keine Datei mit der festgelegten Endung enthalten ist. Es bleibt aber dabei, dass stets alle im benannten Ordner enthaltenen Files mit der vorgegebenen Endung importiert werden.

Damit Sie sich mehr auf das Wesentliche konzentrieren können, haben wir für Sie eine Excel-Datei mit dem Code vorbereitet. Laden Sie dieses File von unserem Server herunter und öffnen Sie per AltF11 den VBA-Editor. Das ist wichtig, weil Sie in jedem Fall den Pfad anpassen müssen, wo die zu importierenden Dateien liegen. Und vielleicht auch den Suffix, falls es keine *.csv sein soll. Diese Änderungen 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-Auswahlfenster (File-Open-Dialog) verzichtet. Erstens gibt es je nach Excel-Version zwei grundlegend verschiedene Typen, die auch nicht untereinander kompatibel sind und zweitens soll das hier nicht im Mittelpunkt stehen. Das ist einem anderen Beitrag, den wir gewiss später erstellen werden, vorbehalten.

Der folgende Code sorgt dafür, dass mit Semikola getrennte Felder einer Textdatei korrekt in Spalten aufgeteilt werden:

'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 Gelegenheit werden die einzelnen Spalten des Imports auch gleich auf die optimale Spaltenbreite eingestellt. – Sie werden natürlich zu Beginn mit Testdaten arbeiten. Es sollten auch nicht all zu viele Einzelfiles und auch Datensätze sein, damit Sie eine bessere Kontrollmöglichkeit haben. Dazu kommt auch, dass Sie ein Gefühl für den Zeitaufwand bekommen. Das Ganze kann schon etwas länger dauern. Sie werden so auch nicht so rasch an einen „Hänger“ denken, wenn bei sehr großen Datenmengen (viele Files, viele Zeilen) importieren. Nur aus diesem Grund haben wir noch die Zeitmessung im Code belassen. Wenn Sie etwas Erfahrung mit dem Importverhalten gesammelt haben, dann werden Sie selbstredend diese Option auskommentieren oder ganz entfernen.

▲ nach oben …

Dieser Beitrag wurde unter Daten-Import / -Export, Mit VBA/Makro, Musterlösungen, Text abgelegt und mit , , , , , , , , verschlagwortet. Setze ein Lesezeichen auf den Permalink.