Option Compare Database

Private Sub ButtonImport_Click()
 Dim strTabellenname As String
 Dim strDateipfad As String
 
 strTabellenname = "Tabelle1"
 strDateipfad = "C:\Users\m.hofelich\Downloads\Test.csv"
 
 Call csvDateiInTabelleEinlesen(strTabellenname, strDateipfad)
End Sub

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