Einlesen von Text- und CSV-Dateien - mal nicht mit PQ

[schauan]

Hallöchen,

mittels VBA gibt es verschiedene Möglichkeiten, Textdateien einzulesen. Oftmals handelt es sich um CSV-Dateien, in denen Daten spaltenweise durch Komma oder Semikolon getrennt - je nach Systemeinstellung - enthalten sind. In den Versionen ab 2010 / 2013 gibt es die Möglichkeit, die Daten mittels Powerquery einzulesen und dabei gleich verschiedene Operationen, z.B. Typumwandlungen, Zusammenfassungen von Daten und Spalten und vieles mehr, auszuführen.
Zuweilen besteht jedoch immer noch die Anforderung, Daten per VBA einzulesen und zu verarbeiten.

Hier sind nun einige Beispielcodes dargestellt, um CSV-Dateien einzulesen. Die Beispiele lassen sich mit wenig Aufwand auch für andere Textdateien umprogrammieren - hier geht es vor allem um den Import der Daten entsprechend der Trennzeichen in einzelne Spalten und Zeilen.
Dabei werden hier die Daten komplett in einem Zug eingelesen und innerhalb der Makros in Arrays übernommen und erst am Ende in die Tabelle eingefügt.
Die Beispiele sind reichlich kommentiert, sollten Fragen, Hinweise oder Verbesserungsvorschläge auftreten, können die im Forum diskutiert und beantwortet werden.
Die eingelesenen Daten werden jeweils versetzt entsprechend den Beispieldaten eingetragen.

Beispieldaten:

	D	E	F
1	Wer	Was	Anzahl
2	ich	auto	1
3	du	Bike	2
4	er	Kutsche	3
5	sie	Roller	1

... in einer CSV semikolasepariert und einer zweiten Datei kommasepariert

Hier nun die Beispiele:

  Read_Text_File_to_Array.xlsm (Größe: 32,81 KB / Downloads: 0)
  01_02.zip (Größe: 346 Bytes / Downloads: 0)

1) Einlesen mit dem FileSystemObject und ReadAll
(einziges Beispiel, in dem die Spalten nicht aufgeteilt werden)

Code:

Sub Read_TxtFile_to_Array()
'Textfile direkt in 1D Array uebernehmen
'mit Scripting.FileSystemObject, Late Binding
'2D Array mit Delimiter siehe andere Beispiele
'Variablendeklarationen
Dim objFSO As Object, objFile As Object
Dim strFile$, arrTxt
'Pfad+Dateiname zuweisen
strFile = "C:\Test\01_ich.csv"
'FSO setzen
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Dateiobjekt oeffnen / zuweisen
Set objFile = objFSO.OpenTextFile(strFile, 1)
'komplettes File in Array einlesen
arrTxt = Split(objFile.Readall, vbNewLine)
'Array ausgeben.
Worksheets("TxtToArr").Range("A1").Resize(UBound(arrTxt) + 1, 1).Value = Application.Transpose(arrTxt)
End Sub

2) Einlesen mit Open... For Input und Input/LOF

Code:

Sub Read_TxtFileDelim_to_array_1()
'Textfile direkt in Array uebernehmen
'mit Open ... For Input und Input
'Variablendeklarationen
Dim strDelim$, strFile$, strCont$
Dim iCnt1%, iCnt2%, iFree%
Dim arrLines() As String, arrData() As String, arrTmp() As String
Dim lRow&, lColumn&
'Trennzeichen festlegen
strDelim = ";"
'Pfad+Dateiname zuweisen
strFile = "C:\Test\01_ich.csv"
'Startzeile festlegen
lRow = 0
'Filenummer fuer Oeffnen der Datei ermitteln und zuweisen
iFree = FreeFile
'Datei zum Einlesen oeffnen
Open strFile For Input As iFree
'Datei komplett einlesen
strCont = Input(LOF(iFree), iFree)
'Datei schliessen
Close iFree
'Zeilen trennen
arrLines() = Split(strCont, vbNewLine)
'Schleife ueber alle "Zeilen" im Array
For iCnt1 = LBound(arrLines) To UBound(arrLines)
  'wenn in der Zeile was steht, dann
  If Len(Trim(arrLines(iCnt1))) <> 0 Then
    'Zeile in Spalten trennen
    arrTmp = Split(arrLines(iCnt1), strDelim)
    'Spaltenzahl ermitteln und zuweisen
    lColumn = UBound(arrTmp)
    'temp. A. entsprechend Spalten neu dimensionieren
    ReDim Preserve arrData(lColumn, lRow)
    'Schleife ueber Spalten des temp.A.
    For iCnt2 = LBound(arrTmp) To UBound(arrTmp)
      'Daten in die entsprechende Array-"Zelle" uebernehmen
      arrData(iCnt2, lRow) = arrTmp(iCnt2)
    'Ende Schleife ueber Spalten des temp.A.
    Next
  'Ende wenn in der Zeile was steht, dann
  End If
'Zeilenzaehler hochsetzen
lRow = lRow + 1
'Ende Schleife ueber alle "Zeilen" im Array
Next
'Daten im Blatt ausgeben, ab D1 (iCnt1 + 1, iCnt2 + 4)
Worksheets("TxtToArr").Cells(1, 4).Resize(lRow - 1, iCnt2).Value = WorksheetFunction.Transpose(arrData())
End Sub

3) Einlesen mit ADO und getrows
(Semikolonsepariert)

Code:

Sub Read_TxtFileDelimSemi_to_array_2()
'Textfile direkt in Array uebernehmen,
'zu beachten: Version fuer semikolaseparierte Datei
'Splitten der csv mit ";" getrennt (bei abweichender Standardeinstellung z.B. ",")
'Hinweis: mmit Systemumstellung, schema.ini im Dateiverzeichnis,
'Registry-Hack oder anderen Maßnahmen kann man das Splitten einsparen
'mit ADO ... und SQL
'benoetigte Verweise:
'Microsoft ActiveX Data Objects 2.x Library (latest) or 6.x
'Variablendeklarationen
Dim rs As New ADODB.Recordset, conn As New ADODB.Connection
Dim strPath$, strFile$, strDelim$, strCont$, strSQL$
Dim iCnt1%, iCnt2%
Dim lRow&, lColumn%
Dim arrHead, arrLines, arrTmp, arrData() As String
'Trennzeichen festlegen
strDelim = ";"
'Pfad+Dateiname festlegen
strPath = "C:\\Test\\": strFile = "01_ich.csv"
'Startzeile festlegen
lRow = 0
'Verbindungsstring festlegen
'32 bit
'conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited()"";"
'64 bit
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=CustomDelimited(;)"";"
'Datenabfrage
strSQL = "SELECT * FROM [01_Ich.csv]"
'Mit dem Recordset
With rs
  'Connection + Einstellungen
  .ActiveConnection = conn
  .CursorType = adOpenKeyset
  .LockType = adLockOptimistic
  'Verbindung mit SQL-Abfrage oeffnen
'  .Open "SELECT * FROM [01_Ich.csv]"
  .Open strSQL ', conn
  'Ergebnis ausgeben, Spaltenbezeichnungen (Ueberschriften) und Daten
  'AO geht davon aus, dass oben die Spaltenbezeichnungen stehen
  arrHead = Split(.Fields(0).Name, strDelim)
  arrLines = WorksheetFunction.Transpose(.GetRows)
  'Datenabfrage schliessen
  .Close
'Ende Mit dem Recordset
End With
'Verbindung schliessen
conn.Close
'Schleife ueber alle "Zeilen" im Array
For iCnt1 = LBound(arrLines, 1) To UBound(arrLines, 1)
  'wenn in der Zeile was steht, dann
  If Len(Trim(arrLines(iCnt1, 1))) <> 0 Then
    'Zeile in Spalten trennen
    arrTmp = Split(arrLines(iCnt1, 1), strDelim)
    'Spaltenzahl ermitteln und zuweisen
    lColumn = UBound(arrTmp)
    'temp. A. entsprechend Spalten neu dimensionieren
    ReDim Preserve arrData(lColumn, lRow)
    'Schleife ueber Spalten des temp.A.
    For iCnt2 = LBound(arrTmp) To UBound(arrTmp)
      'Daten in die entsprechende Array-"Zelle" uebernehmen
      arrData(iCnt2, lRow) = arrTmp(iCnt2)
    'Ende Schleife ueber Spalten des temp.A.
    Next
  'Ende wenn in der Zeile was steht, dann
  End If
'Zeilenzaehler hochsetzen
lRow = lRow + 1
'Ende Schleife ueber alle "Zeilen" im Array
Next
'Spaltenueberschriften eintragen, ab H1
Worksheets("TxtToArr").Cells(1, 9).Resize(1, UBound(arrHead) + 1).Value = arrHead
'Daten im Blatt ausgeben, ab H2
Worksheets("TxtToArr").Cells(2, 9).Resize(UBound(arrData, 2) + 1, UBound(arrData, 1) + 1).Value = WorksheetFunction.Transpose(arrData)
End Sub

4) Einlesen mit ADO und getrows
(Kommasepariert)

Code:

Sub Read_TxtFileDelimComma_to_array_3()
'Textfile direkt in Array uebernehmen,
'zu beachten: Version fuer commaseparierte Datei
'mit ADO ... und SQL
'benoetigte Verweise:
'Microsoft ActiveX Data Objects 2.x Library (latest) or 6.x
'Variablendeklarationen
Dim rs As New ADODB.Recordset, conn As New ADODB.Connection
Dim strPath$, strFile$
Dim iCnt%
Dim arrHead, arrLines
'Pfad+Dateiname festlegen, 2. Beispielfile ist Kommagetrennt!
strPath = "C:\\Test\\": strFile = "02_ich.csv"
'Verbindungsstring festlegen
'32 bit
'conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=Delimited()"";"
'64 bit
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""text;HDR=Yes;FMT=CustomDelimited(,)"";"
'Datenabfrage
strSQL = "SELECT * FROM [02_Ich.csv]"
'Mit dem Recordset
With rs
  'Connection + Einstellungen
  .ActiveConnection = conn
  .CursorType = adOpenKeyset
  .LockType = adLockOptimistic
  'Verbindung mit SQL-Abfrage oeffnen
  .Open strSQL
  'Ergebnis ausgeben, Spaltenbezeichnungen (Ueberschriften) und Daten
  'AO geht davon aus, dass oben die Spaltenbezeichnungen stehen
  'Kopfarray dimensionieren - Kopfnamen werden gesondert ausgelesen!
  ReDim arrHead(.Fields.Count - 1)
  'Schleife ueber alle Kopfnamen (Feldnamen)
  For iCnt = 0 To UBound(arrHead)
    'Kopfname uebernehmen
    arrHead(iCnt) = .Fields.Item(iCnt).Name
  'Ende Schleife ueber alle Kopfnamen (Feldnamen)
  Next
  'Daten uebernehmen
  arrLines = WorksheetFunction.Transpose(.GetRows)
  'Datenabfrage schliessen
  .Close
'Ende Mit dem Recordset
End With
'Verbindung schliessen
conn.Close
'Spaltenueberschriften eintragen, ab L1
Worksheets("TxtToArr").Cells(1, 14).Resize(1, UBound(arrHead) + 1).Value = arrHead
'Daten im Blatt ausgeben, ab J2
Worksheets("TxtToArr").Cells(2, 14).Resize(UBound(arrLines, 1), UBound(arrLines, 2)).Value = (arrLines)
End Sub

5) Einlesen mit dem und TextStream/Readall

Code:

Sub Read_TxtStream_ToArray()
'einige Konstanten - zur Info und Verwendung
Const ForReading = 1, ForWriting = 2, ForAppending = 8
'Format = Systemvorgabe, Unicode, ASCII
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
'Variablendeklarationen
Dim objFSO As Object, objFile As Object, objTxtStr As Object
Dim strFile$, strDelom$, arrLines, arrTmp, arrData() As String
'Pfad+Dateiname zuweisen
strFile = "C:\Test\01_ich.csv"
'Trennzeichen festlegen
strDelim = ";"
'FSO setzen
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Dateiobjekt  zuweisen
Set objFile = objFSO.GetFile(strFile)
'Dateiobjekt oeffnen
Set objTxtStr = objFile.OpenAsTextStream(ForReading, TristateUseDefault)
'Dateiinhalt auslesen und an Array zuweisen
arrLines = Split(objTxtStr.Readall, vbNewLine)
'Dateiobjekt schliessen
objTxtStr.Close
'Startzeile festlegen
lRow = 0
'Schleife ueber alle "Zeilen" im Array
For iCnt1 = LBound(arrLines) To UBound(arrLines)
  'wenn in der Zeile was steht, dann
  If Len(Trim(arrLines(iCnt1))) <> 0 Then
    'Zeile in Spalten trennen
    arrTmp = Split(arrLines(iCnt1), strDelim)
    'Spaltenzahl ermitteln und zuweisen
    lColumn = UBound(arrTmp)
    'temp. A. entsprechend Spalten neu dimensionieren
    ReDim Preserve arrData(lColumn, lRow)
    'Schleife ueber Spalten des temp.A.
    For iCnt2 = LBound(arrTmp) To UBound(arrTmp)
      'Daten in die entsprechende Array-"Zelle" uebernehmen
      arrData(iCnt2, lRow) = arrTmp(iCnt2)
    'Ende Schleife ueber Spalten des temp.A.
    Next
  'Ende wenn in der Zeile was steht, dann
  End If
'Zeilenzaehler hochsetzen
lRow = lRow + 1
'Ende Schleife ueber alle "Zeilen" im Array
Next
'Daten im Blatt ausgeben, ab D1 (iCnt1 + 1, iCnt2 + 4)
Worksheets("TxtToArr").Cells(1, 19).Resize(UBound(arrData, 2) + 1, UBound(arrData, 1) + 1).Value = WorksheetFunction.Transpose(arrData)
End Sub