VBA Tipp: csv-Datei in neue Tabelle einlesen

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

  • Ich möchte den Inhalt einer csv-Datei in eine Access-Tabelle einlesen. Alle Tabellenfelder haben den Felddatentyp Text (Kurzer Text) und die Feldgröße 255.
  • Das Trennzeichen für die Felder in der csv-Datei muss der Strichpunkt sein.
  • Die Tabelle wird automatisch angelegt. Falls die Tabelle bereits existiert, wird sie überschrieben.

Lösung

Das geht mit folgender Sub-Prozedur, die in einem allgemeinen (globalen) Modul gespeichert wird.

Argumente der Prozedur:

  • Tabellenname: Name der anzulegenden Tabelle. Der Tabellenname darf maximal 64 Zeichen lang sein.
  • Dateipfad: Pfad und Name der csv-Datei.
  • EnthältSpaltenüberschriften (Optional): Auf True setzen, wenn die csv-Datei in der ersten Zeile Spaltenüberschriften enthält. Die Spaltenüberschriften werden für die Tabellen-Feldnamen verwendet. Der Standardwert ist False.
Public Sub CSVDateiInTabelleEinlesen(Tabellenname As String, _
                                     Dateipfad As String, _
                                     Optional EnthältSpaltenüberschriften As Boolean)
 
 ' Quelle: http://www.dbwiki.net/
 
 Dim db            As DAO.Database
 Dim rs            As DAO.Recordset
 Dim tdf           As DAO.TableDef
 Dim fld           As DAO.Field
 Dim fldName       As String
 Dim Zeile         As Variant
 Dim Zeichen       As String
 Dim strWert       As String
 Dim arrWerte()    As String
 Dim dNum          As Integer
 Dim boltextmodus  As Boolean
 Dim bolkomplett   As Boolean
 Dim lngFeldNr     As Long
 Dim i             As Long
 Dim j             As Long
 Dim k             As Long
 Dim z             As Long
 Dim lnglen        As Long
 
 Set db = CurrentDb
 
 ' Tabelle löschen, falls sie schon existiert
 On Error Resume Next
 db.TableDefs.Delete Tabellenname
 On Error GoTo 0
 
 ' CSV-Datei öffnen
 dNum = FreeFile()
 Open Dateipfad For Input As dNum
 
 ' Datei zeilenweise durchlaufen
 Do Until EOF(dNum)
 
   ' Zählvariable pro Zeile
   k = k + 1
 
   ' Zeile aus Datei auslesen
   Line Input #dNum, Zeile
 
   ' Zeichen 10 herausnehmen
   Zeile = Replace(Zeile, Chr(10), vbNullString)
 
   ' Anfangswert für Arrayplatzberechnung
   lngFeldNr = -1
 
   lnglen = Len(Zeile)
 
   ' Zeile durchlaufen
   For i = 1 To lnglen
 
     Zeichen = Mid$(Zeile, i, 1)
 
     ' Anführungszeichen zählen
     If Zeichen = Chr(34) Then
 
       z = z + 1
 
     ' Wenn sonstige Zeichen
     Else
 
       ' Gezählte Anführungszeichen auswerten
       If z > 0 Then
 
         If z = 1 Or z = 3 Then
           boltextmodus = Not boltextmodus
         End If
 
         If z = 2 Or z = 3 Then
           strWert = strWert & Chr(34)
         End If
 
         z = 0
 
       End If
 
       ' Wenn Strichpunkt und kein Textmodus
       If Zeichen = ";" And Not boltextmodus Then
 
         ' Eintrag abschließen
         bolkomplett = True
 
       Else
 
         ' Zeichen schreiben
         strWert = strWert & Zeichen
 
       End If
 
     End If
 
     ' Wenn letztes Zeichen der Zeile erreicht ist
     If i = lnglen Then
 
       ' Gezählte Anführungszeichen auswerten
       If z = 3 Then
         strWert = strWert & Chr(34)
       End If
       z = 0
 
       boltextmodus = False
       bolkomplett = True
 
     End If
 
     ' Wenn der Feldwert komplett ist, in Array einlesen
     If bolkomplett Then
 
       lngFeldNr = lngFeldNr + 1
       ReDim Preserve arrWerte(lngFeldNr)
       arrWerte(lngFeldNr) = strWert
 
       ' Initialisierung
       strWert = vbNullString
       bolkomplett = False
 
     End If
 
   Next i
 
   ' Wenn Zeile 1: Feldnamen erstellen
   If k = 1 Then
 
     For i = 0 To lngFeldNr
 
       ' Wenn die Überschrift leer ist oder die CSV-Datei keine Spaltenüberschriften enthält
       If arrWerte(i) = vbNullString Or EnthältSpaltenüberschriften = False Then
 
         ' Dummy-Feldnamen erzeugen
         fldName = "Feld_" & i + 1
 
       Else
 
         ' Feldnamen auf max. 64 Zeichen begrenzen
         fldName = Left(arrWerte(i), 64)
 
         ' Zeichen auf Gültigkeit prüfen
         For j = 1 To Len(fldName)
 
           Zeichen = Mid$(fldName, j, 1)
 
           Select Case Zeichen
 
             ' Bestimmte Zeichen unverändert lassen
             Case "A" To "Z", "a" To "z", 0 To 9, " ", "-", "+", "_", "#", _
                  "§", "$", "%", "&", "/", "(", ")", "|", "@", "€", ">", "<"
 
             ' Ungültige Zeichen und weitere Sonderzeichen durch Unterstrich ersetzen
             Case Else
              fldName = Replace(fldName, Zeichen, "_")
 
           End Select
 
         Next j
 
       End If
 
       ' Wenn Spalte 1: Tabelle erstellen
       If i = 0 Then
 
         ' TableDef-Objekt erstellen
         Set tdf = db.CreateTableDef(Tabellenname)
 
         ' Die neue Tabelle muß mindestens 1 Feld enthalten: Erstes Feld anlegen
         Set fld = tdf.CreateField(fldName, dbText, 255)
 
         ' Field-Objekt an Fields-Auflistung des TableDef-Objekts anfügen
         tdf.Fields.Append fld
         tdf.Fields.Refresh
 
         ' TableDef-Objekt an TableDefs-Auflistung anfügen
         db.TableDefs.Append tdf
         db.TableDefs.Refresh
 
       ' Wenn weitere Spalten: Felder erstellen
       Else
 
         ' Fieldobjekt erzeugen
         Set fld = tdf.CreateField(fldName, dbText, 255)
 
         ' Field-Objekt an Fields-Auflistung des TableDef-Objekts anfügen
         tdf.Fields.Append fld
         tdf.Fields.Refresh
 
         ' Speicher freigeben
         Set fld = Nothing
 
       End If
 
     Next i
 
     ' Speicher freigeben
     Set tdf = Nothing
 
     ' Erstellte (leere) Tabelle in Recordset einlesen
     Set rs = CurrentDb.OpenRecordset(Tabellenname, dbOpenTable, dbAppendOnly)
 
   End If
 
   ' Wenn weitere Zeilen: Feldinhalte als Daten in die Tabelle einlesen
   If k > 1 Or EnthältSpaltenüberschriften = False Then
 
     rs.AddNew
 
     For i = 0 To lngFeldNr
       If arrWerte(i) = vbNullString Then
         rs(i) = Null
       Else
         rs(i) = Left$(arrWerte(i), 255)
       End If
     Next i
 
     rs.Update
 
   End If
 
   ' Array leeren
   Erase arrWerte()
 
 Loop
 
 ' Speicher freigeben
 If Not rs Is Nothing Then rs.Close: Set rs = Nothing
 If Not db Is Nothing Then db.Close: Set db = Nothing
 Close #dNum
 
End Sub

Aufruf

   Dim strTabellenname  As String
   Dim strDateipfad     As String
 
   strTabellenname = "Tabelle1"
   strDateipfad = CurrentProject.Path & "\Meine.csv"
 
   ' Beispiel 1: csv-Datei enthält kaine Spaltenüberschriften
   Call CSVDateiInTabelleEinlesen(strTabellenname, strDateipfad)
 
   ' Beispiel 2: csv-Datei enthält Spaltenüberschriften
   Call CSVDateiInTabelleEinlesen(strTabellenname, strDateipfad, True)

Hinweise

  • Alle Tabellenfelder haben den Datentyp "Text" mit 255 Zeichen, d.h. die Feld-Datentypen und die Feldnamen müssen ggf. angepasst werden.
  • Feldinhalte, die länger als 255 Zeichen sind, werden abgeschnitten.


Wiki warning.png

Achtung: Falls die Tabelle bereits existiert, wird diese ohne Vorwarnung überschrieben!


Weblinks