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 werden. Jede Textdatei wird in eine eigene Tabelle, in ein eigenes Sheet geschrieben werden. 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 Nachfrage 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 gleichermaß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 programmierbar. Wenn Sie das vorhaben, achten Sie beim eventuellen Nachschlagen im Web unbedingt 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 Arbeitsumgebung 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 😉 .
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ührungszeichen darf auch sein. Das unterscheidet diese Version von der vorherigen, welche ganz zu Beginn dieses Beitrages schon angesprochen worden ist . – Dateien dieser Art werden 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 Format exportieren, und genau dieses Format liegt Ihnen hier vor. Auch wenn die Dateinamenerweiterung *.txt lautet. – Und noch etwas ist wichtig, ja unverzichtbar: Der Aufbau 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 Dateien 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. 😎
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 … 😛
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 Neuberechnung 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 Textdateien 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.
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
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.
[NachObenLetzte Verweis=“ML: csv-Import (2)“]