Option Explicit
Option Compare Text
' ****************************************************************
' Autor/en und Original-Quelltext unter:
' https://www.online-vba.de/vba_updatedbfield.php
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von https://www.online-vba.de
' ****************************************************************
Public Sub OVBAde_DatenInAccessDBschreiben()
Dim oADODBConnection As Object
Dim oRecordSet As Object
Dim sTableName As String
Dim sFilterKlausel As String
'Welcher Datensatz in welcher Tabelle?
sTableName = "MeineTabelle"
sFilterKlausel = "ID=1"
'Datenbankdatei (hier Access DB)
sDataBaseFile = "C:\TEST\Testdatenbank.accdb" 'wo liegt die Datei?
If Trim(CStr(Dir(sDataBaseFile))) = "" Then
MsgBox "Die Datenbank-Datei: " & sDataBaseFile & _
" wurde nicht gefunden.", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Verbindung zur Datenbank
Set oADODBConnection = CreateObject("ADODB.Connection") 'LateBinding, daher ohne Verweis
With oADODBConnection
.Provider = "Microsoft.ACE.OLEDB.12.0" 'für Access 2013
.Properties("Persist Security Info") = "False"
.Properties("Data Source") = sDataBaseFile
.Open
End With
'RecordSet öffnen
Set oRecordSet = CreateObject("ADODB.RecordSet") 'LateBinding, daher ohne Verweis
With oRecordSet
.CursorLocation = 3 'adUseClient
.CursorType = 2 'adOpenDynamic
.LockType = 3 'adLockOptimistic
.Open sTableName, oADODBConnection
.Filter = sFilterKlausel 'Filter setzen, ID muss 1 sein!
End With
'Daten schreiben
If Not oRecordSet.EOF Then 'Nur wenn der Datensatz gefunden wurde ID=1
'Wertzuweisung: MeinFeld bekommt "Neuer Wert!"
'Bei Zahlen entsprechend: oRecordSet.Fields("MeinFeld") = 12
oRecordSet.Fields("MeinFeld") = "Neuer Wert!"
'Speichern / Aktualisieren
oRecordSet.Update
End If
'RecordSet schließen
oRecordSet.Close
'Datenbankverbindung schließen
oADODBConnection.Close
Set oRecordSet = Nothing
Set oADODBConnection = Nothing
End Sub