VBA Tipp: csv-Datei in neue Tabelle einlesen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

  • Ich möchte den Inhalt einer csv-Datei in eine Access-Tabelle einlesen.
  • Die Tabelle wird automatisch erzeugt.
  • Die erste Zeile der csv-Datei muss die Excel-Spaltenüberschriften enthalten, die für die Access-Feldnamen verwendet werden.

Lösung

Das geht mit folgender Prozedur, die in einem globalen Modul hinterlegt wird:

Public Sub csvDateiInTabelleEinlesen(ByVal Tabellenname As String, ByVal Dateipfad As String)
 
 'Die erste Zeile der csv-Datei muss die Spaltenüberschriften enthalten.
 'Falls die Tabelle bereits existiert, wird sie gelöscht.
 'Quelle: http://www.dbwiki.net/
 
 Dim db As DAO.Database
 Dim rs As DAO.Recordset
 Dim d As Long
 Dim Zeile As Variant
 Dim arrWerte As Variant
 Dim i As Integer
 Dim j As Integer
 Dim tdf As DAO.TableDef
 Dim fld As DAO.Field
 Dim fldname As String
 
 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
 d = FreeFile
 Open Dateipfad For Input As #d
 
 'Datei zeilenweise durchlaufen
 Do While Not EOF(d)
 
   'Zeile auslesen, einzelne Werte in Array einlesen
   Line Input #d, Zeile
   arrWerte = Split(Zeile, ";")
   j = j + 1
 
   'Tabellennamen aus der ersten Zeile (=Überschriften) auslesen
   If j = 1 Then
 
     'Array durchlaufen
     For i = 0 To UBound(arrWerte)
 
       'Wenn kein Wert existiert
       If arrWerte(i) = "" Then
         fldname = "Spalte " & i + 1
       Else
         fldname = arrWerte(i)
 
         'Ungültige Zeichen ersetzen
         fldname = Replace(fldname, Chr(10), " ")
         fldname = Replace(fldname, Chr(34), "")
         fldname = Replace(fldname, ".", "_")
         fldname = Replace(fldname, "!", "")
 
       End If
 
       'Spalte 1
       If i = 0 Then
 
         'TableDef-Objekt erstellen
         Set tdf = db.CreateTableDef(Tabellenname)
 
         ' Die neue Tabelle muß mindestens 1 Feld enthalten: 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 der Datenbank anfügen
         db.TableDefs.Append tdf
         db.TableDefs.Refresh
 
       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
 
     'Tabelle in Recordset einlesen
     Set rs = CurrentDb.OpenRecordset(Tabellenname, dbOpenDynaset)
 
   'Werte in Tabelle einlesen
   Else
     rs.AddNew
 
     For i = 0 To UBound(arrWerte)
       rs(i) = IIf(arrWerte(i) = "", Null, Left(arrWerte(i), 255))
     Next i
 
     rs.Update
   End If
 
 Loop
 
 Close #d
 
End Sub

Aufruf

 Dim strTabellenname As String
 Dim strDateipfad As String
 
 strTabellenname = "Tabelle1"
 strDateipfad = CurrentProject.Path & "\Meine.csv"
 
 Call csvDateiInTabelleEinlesen(strTabellenname, strDateipfad)

Hinweise

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


Wiki warning.png Achtung: Falls die Tabelle bereits existiert, wird sie ohne Vorwarnung überschrieben!