Aus Excel herau Access Prozedur ausführe
20.10.2020 10:15:07
Steven
kann mir bitte jemand sagen ob und wie es möglich ist aus einer Excel Prozedur heraus eine Prozedur in Access zu starten?
Folgendes Szenario:
Es besteht ein Excelfile mit Bestelldaten. Diese Bestelldaten möchte ich an eine Datenbank übergeben, was bislang schon funktioniert. Aktuell muss ich aber noch die Datenbank öffnen und den Command-button für Speichern klicken, damit die Prozedur ausgeführt wird. Das möchte ich aber automatisieren.
Bislang habe ich es aber nur hinbekommen, dass ich die Form öffne, den Fokus auf die Schaltfläche lege, aber nicht diese zu betätigen bzw. die dahinterliegende Prozedur aufzurufen.
Die in Access ist ein Microsoft Access Klassenobjekt und die Prozedur ist "Private".
Nachfolgend der Code mit dem ich die Daten an die Datenbank übergebe:
Sub DataToAccess(strGN)
Dim ADOC As ADODB.Connection
Dim DBS As ADODB.Recordset
Dim lngZeile As Long
Dim intIndex As Integer
Dim arG, arH, arA, arAH, arK, arKO, arD, arT, arKW, arKW2, arMail, arAutoMail As Variant
Dim SuchGerät As String
Dim x As Integer
On Error GoTo Fehler
Set ADOC = New ADODB.Connection
With ADOC
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open "S:\Anlagen\Zentralanlagen-Verwaltung.mdb"
End With
Set DBS = New ADODB.Recordset
DBS.Open "zentralanlagen", ADOC, adOpenKeyset, adLockOptimistic
With Sheets("Auftragseingang")
SuchGerät = strGN
If SuchGerät = "" Then Exit Sub
x = 2
Do Until Sheets("Auftragseingang").Range("C" & x) = SuchGerät
x = x + 1
Loop
arG = .Range("C1")
arH = .Range("A1")
arA = .Range("B1")
arAH = .Range("AF1")
arK = .Range("AG1")
arKO = .Range("AH1")
arD = .Range("J1")
arT = .Range("AE1")
arD = .Range("J1")
arKW = "gewünschter Liefertermin"
arKW2 = "möglicher Liefertermin"
arMail = "eMailAdresse"
arAutoMail = "AutoeMail"
DBS.AddNew
DBS.Fields(arG) = .Cells(x, 3).Value
DBS.Fields(arH) = .Cells(x, 1).Value
DBS.Fields(arA) = .Cells(x, 2).Value
DBS.Fields(arAH) = .Cells(x, 32).Value
DBS.Fields(arK) = .Cells(x, 33).Value
DBS.Fields(arKO) = .Cells(x, 34).Value
DBS.Fields(arD) = .Cells(x, 10).Value
DBS.Fields(arT) = .Cells(x, 31).Value
DBS.Fields(arD) = .Cells(x, 10).Value
DBS.Fields(arKW) = .Cells(x, 15).Value
DBS.Fields(arKW2) = .Cells(x, 15).Value
DBS.Fields(arMail) = .Cells(x, 42).Value
DBS.Fields(arAutoMail) = .Cells(x, 43).Value
DBS.Update
Sheets("Auftragseingang").Range("AR" & x) = "x"
End With
Fehler:
If Err.Number Then MsgBox Err.Description, , Err.Number ' ggf. eine Fehlermeldung ausgeben
DBS.Close
ADOC.Close
Set ADOC = Nothing
Set DBS = Nothing
Hell:
End Sub