Home Office Tips Excel VBA Excel speichert in Access Datenbank
Excel speichert in Access Datenbank PDF Print E-mail

Mit Excel in einer Access Datenbank lesen und schreiben.

 

Verweis: Microsoft AciveX Data Objects 2.X Library

 

 

Code:

 

Public Sub db_lesen()
Dim pfad
Dim conn As New ADODB.Connection
Dim rs_daten As New ADODB.Recordset
Dim id As String
    id = Range("C4").Value
    pfad = ActiveWorkbook.Path & "\test.mdb"
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pfad
    Set rs_daten = New ADODB.Recordset
    With rs_daten
      .ActiveConnection = conn
      .CursorType = adOpenKeyset
      .CursorLocation = adUseServer
      .LockType = adLockOptimistic
      .Source = "Tabelle1"
      .Open Options:=adCmdTableDirect
    End With
    rs_daten.Index = "PrimaryKey"
    rs_daten.Seek (id)
    If rs_daten.BOF = True Or rs_daten.EOF = True Then
        MsgBox "Datensatz nicht gefunden."
    Else
        Range("C8").Value = rs_daten.Fields("Text1").Value
        Range("C9").Value = rs_daten.Fields("Text2").Value
        Range("C10").Value = rs_daten.Fields("Text3").Value
    End If
    rs_daten.Close
    conn.Close
End Sub


Public Sub db_schreiben()
Dim pfad
Dim conn As New ADODB.Connection
Dim rs_daten As New ADODB.Recordset
Dim id As String
    id = Range("C4").Value
    pfad = ActiveWorkbook.Path & "\test.mdb"
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pfad
    Set rs_daten = New ADODB.Recordset
    With rs_daten
      .ActiveConnection = conn
      .CursorType = adOpenKeyset
      .CursorLocation = adUseServer
      .LockType = adLockOptimistic
      .Source = "Tabelle1"
      .Open Options:=adCmdTableDirect
    End With
    rs_daten.Index = "PrimaryKey"
    rs_daten.Seek (id)
    If rs_daten.BOF = True Or rs_daten.EOF = True Then
        MsgBox "Datensatz nicht gefunden."
    Else
        rs_daten.Fields("Text1").Value = Range("C8").Value
        rs_daten.Fields("Text2").Value = Range("C9").Value
        rs_daten.Fields("Text3").Value = Range("C10").Value
    End If
    rs_daten.Update
    rs_daten.Close
    conn.Close
End Sub

 

 

Excel-Access.zip