Private Sub cmd_einlesen_Click()
Dim strDB As String
Dim strCon As String
Dim SQL As String
Dim objCon As Object
Dim objRst As Object
strDB = ThisWorkbook.Path & "\Test_Datenbank.accdb"
Set objCon = CreateObject("ADODB.CONNECTION")
Set objRst = CreateObject("ADODB.Recordset")
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDB & _
";Persist Security Info=False;"
objCon.Open strCon
SQL = "Insert Into tbl_Namen(Vorname, Nachname) Values ('" & Tabelle1.Range("H4").Value & "','" & Tabelle1.Range("I4").Value & "');"
objRst.Open SQL, strCon, 1, 1, 1
objRst.Close: objCon.Close
Set objRst = Nothing: Set objCon = Nothing
End Sub
Sub ImportEinzelWerteExcelToAccess()
Dim accApp As Object, accDB As Object, accRS As Object
Dim WSh As Worksheet
Dim sDB As String, sTabelle As String
Dim i As Integer
sDB = "C:\Users\voltm\Desktop\MyTools\Daten\MeineTestdatenbank.accdb"
sTabelle = "MyTestTable"
Set WSh = ThisWorkbook.Sheets("Tabelle1")
Set accApp = CreateObject("ACCESS.Application")
accApp.Visible = True
Call accApp.OpenCurrentDatabase(sDB, False)
Set accDB = accApp.CurrentDb
Set accRS = accDB.OpenRecordset(sTabelle)
With accRS
For i = 6 To 7
.AddNew
.Fields(0) = WSh.Cells(i, 6).Value
.Update
Next i
.Close
End With
accApp.DoCmd.CloseDatabase
accApp.Quit
Set accRS = Nothing
Set accDB = Nothing
Set accApp = Nothing
End Sub