Die Methode DBEngine für das Objekt...
29.11.2018 09:58:27
Jonas
Die Methode DBEngine für das Objekt _application ist fehlgeschlagen.
Mit den Sub importiere ich Abfragen aus meiner Access Datenbank (accdb) in Excel (xlsb), um sie dort _
weiter zu bearbeiten. Die Exceltabelle und das Backend meiner Datenbank liegen beide auf unserem Netzlaufwerk. Es gibt zwei unterschiedliche Varianten darauf zuzugreifen. Entweder lokal über den eigenen Computer, oder über eine Remoteverbindung die sich auf den Server aufschaltet. Bei der ersten Variante funktioniert der Code hervorragend, lediglich über die Remoteverbindung erscheint die genannte Fehlermeldung, obwohl man auf dieselben Dateien zugreift. Auch die Officeversion ist bei beiden Varianten gleich. Ich kann mir den Fehler einfach nicht erklären.
Hier das erwähnte Sub:
Sub DatenImport()
Dim wksRohdaten As Worksheet, wksRohdatenSheet, wksQualificationLevel As Worksheet, _
wksCrossQualification As Worksheet
Dim appAccess As Object
Dim accDB As Object
Dim accRst As Object
Dim accRst2 As Object
Dim accRst3 As Object
Dim accRst4 As Object
Dim accRst5 As Object
Dim accRst6 As Object
Dim accRst7 As Object
Dim strConnect As String
Set wksRohdaten = Sheets("Rohdaten")
Set wksQualificationLevel = Sheets("QualificationLevelXWB")
Set wksCrossQualification = Sheets("CrossQualification")
Set wksRohdatenSheet = Sheets("RohdatenSheet")
Const DB_NAME As String = "P:\500_Production\Production_Capacity\Datenbank\ _
Stammdatenbank_be.accdb" 'Datenbank
Const PASSWORT As String = "******" 'Passwort
'Connect String
strConnect = "ms access;pwd=" & PASSWORT & ";database=" & DB_NAME
'neues Access Object
Set appAccess = CreateObject("Access.Application")
'Datenbank öffnen
Set accDB = appAccess.DBEngine(0).OpenDatabase( _
DB_NAME, _
Options:=False, _
ReadOnly:=True, _
Connect:=strConnect)
'neues Recordset
Set accRst = accDB.OpenRecordset("qryCompetenceGridXWB")
Set accRst2 = accDB.OpenRecordset("qryCompetenceQualificationOSXWB")
Set accRst3 = accDB.OpenRecordset("qryCompetenceQualificationSpecificXWB")
Set accRst4 = accDB.OpenRecordset("qryCompetenceQualificationOSSA")
Set accRst5 = accDB.OpenRecordset("qryCompetenceQualificationOSLRFWD")
Set accRst6 = accDB.OpenRecordset("qryCompetenceQualificationOSLRAFT")
Set accRst7 = accDB.OpenRecordset("qryCompetenceGridSheetXWB")
'Inhalt Tabellenblätter Rohdaten löschen um Alteinträge zu entfernen
wksRohdaten.Range("A2:N100000").ClearContents
wksQualificationLevel.Range("A2:D100000").ClearContents
wksCrossQualification.Range("A2:F100000").ClearContents
wksRohdatenSheet.Range("A2:C100000").ClearContents
'Daten ausgeben
wksRohdaten.Range("A2").CopyFromRecordset accRst
wksQualificationLevel.Range("A2").CopyFromRecordset accRst2
wksQualificationLevel.Range("C2").CopyFromRecordset accRst3
wksCrossQualification.Range("A2").CopyFromRecordset accRst4
wksCrossQualification.Range("C2").CopyFromRecordset accRst5
wksCrossQualification.Range("E2").CopyFromRecordset accRst6
wksRohdatenSheet.Range("A2").CopyFromRecordset accRst7
accRst.Close
accRst2.Close
accRst3.Close
accRst4.Close
accRst5.Close
accRst6.Close
accRst7.Close
accDB.Close
Set accDB = Nothing
Set accRst = Nothing
Set accRst2 = Nothing
Set accRst3 = Nothing
Set accRst4 = Nothing
Set accRst5 = Nothing
Set accRst6 = Nothing
Set accRst7 = Nothing
'Pivot aktualisieren
For Each wks In Worksheets
For Each pt In wks.PivotTables
pt.PivotCache.Refresh
Next
Next
End Sub
Hat einer von euch eventuell eine Erklärung dafür? Leider ist die Funktion über die Remote für die spätere Arbeitsweise der DB essentiell, da viele Mitarbeiter ausschließlich über die Remote arbeiten und auf ihren eigenen Computern gar kein Office installiert ist.Liebe Grüße und vielen Dank
Jonas