Datenexport nach Access
01.07.2018 16:01:38
Jürgen
folgendes Problem bekomme ich alleine nicht gelöst. Nachdem ich schon vergebens im Internet gesucht habe wende ich mich nunmehr an Euch.
Ich möchte Datensäte von Excel in eine Access-Datenbank schreiben..
Ein Datensatz besteht aus folgenden Spalten:
Spalte A: Datum; Spalte B: Nachname; Spalte C: Wohnort; Spalte D: Eingang; Spalte E: Ausgang
Falls der Eintrag in der Access-Datenbank bereits besteht, soll dieser überschrieben werden, falls nicht, neu angelegt werden
Ich habe im Internet nun ein Makro gefunden, dass dieses schon annähernd löst.
Nur benötige ich die Suchabfrage nicht nur für 1 Feld, sondern für 3 Felder, also das Datum, den Nachnamen und den Wohnort. Dieses soll überprüft werden, ob Daten bereits vorhanden sind.
Vielen Dank.
Hier die Prozedur:
Sub Uebertragen()
Dim Datenbank As Object
Dim RS As Object
Dim strPath As String
Dim suchText As String
Dim Abfrage As String
On Error Resume Next
Set Datenbank = CreateObject("DAO.DBEngine.36")
If Datenbank Is Nothing Then
Set Datenbank = CreateObject("DAO.DBEngine.120")
'Set Datenbank = CreateObject("DAO.DBEngine.35")
End If
If Datenbank Is Nothing Then
MsgBox "Fehlende Komponenten!", vbCritical, "schwerer Programmfehler!"
End
End If
On Error GoTo 0
strPath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
Set Datenbank = Datenbank.OpenDatabase(strPath & "\Datenbank1.mdb", False, False)
Set RS = Datenbank.OpenRecordset("SELECT * FROM Daten")
suchText = "Datum Like '" & Worksheets("Datenbank").Range("A2").Text & "'"
With RS 'Recortset
.FindFirst suchText
If .NoMatch Or (.EOF And .BOF) Then
'DS mit dieser ID nicht gefunden
.AddNew
.Fields(0) = Worksheets("Datenbank").Range("A2")
Else
'vorhanden wird Bearbeitet
.Edit
End If
.Fields(1) = Worksheets("Datenbank").Range("B2")
.Fields(2) = Worksheets("Datenbank").Range("C2")
.Fields(3) = Worksheets("Datenbank").Range("D2")
.Fields(4) = Worksheets("Datenbank").Range("E2")
.Update
.Close
End With
End Sub