PDA

Vollständige Version anzeigen : AllowBypassKey via ADO


Mathis
30.05.2012, 18:19
Hallo an alle,

ich habe mich mal wieder wie verrückt durch alle möglichen Foren gearbeitet, viele Versuche unternommen und konnte kein Ergebnis erzielen.
Ich möchte die Shift-Taste bei mehreren Datenbanken unterdrücken, den Code aber nicht wieder und wieder schreiben, sondern alles von einem Formular aus steuern. Ich habe eine Tabelle mit den kompletten Dateipfaden und einem Kontrollkästchen. Mit einer Abfrage selektiere ich die aktuelle Datenbank, mit einer anderen die fremden DB. Da ich mit DAO noch weniger Kontakt hatte als mit ADO hielt ich das für den besseren Ansatz. Mit dem gezeigten Quelltext habe ich es (meiner Meinung nach) fast geschaft. Zwei Probleme entstehen aber:
1) Der Shift-Key wird nicht unterdrückt
2) Bei der fremden Datenbank erhalte ich folgenden Fehler:

"Ein Objekt mit das dem angeforderten Namen oder dem Ordinalverweis entspricht, kann nicht gefunden werden" Nr.: 3265

Hier der Quelltext:

Option Compare Database
Option Explicit

Private Sub ExitFrm_Click()
Dim strQryThisDB As String
Dim strQryOtherDB As String
Dim strRowPath As String
Dim strRowGrAcc As String
Dim conn1 As ADODB.Connection
Dim conn2 As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim strPath As String
Dim boolGrAcc As Boolean

On Error GoTo Err_ExitFrm_Click

If MsgBox("Wollen Sie die Anwendung beenden und" & vbCr & "evtl. Änderungen speichern?", _
vbQuestion & vbYesNo, "Anwendung beenden") = vbNo Then
GoTo Exit_ExitFrm_Click
End If

'Datensatz speichern
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

strQryThisDB = "Sperre_aktuellle_DB_A"
strQryOtherDB = "Sperre_restl_DB_A"
strRowPath = "Dateipfad"
strRowGrAcc = "Sperrung_Datenansicht"

Set conn1 = CurrentProject.Connection
RS.Open strQryThisDB, ActiveConnection:=conn1
boolGrAcc = RS.Fields(strRowGrAcc)
RS.Close

'TRUE bedeutet Sperrung, FALSE bedeutet keine Sperrung
On Error GoTo Err_ExitFrm_Click
If boolGrAcc = True Then
CurrentProject.Properties("AllowBypassKey") = False
Else: CurrentProject.Properties("AllowBypassKey") = True
End If

RS.Open strQryOtherDB, ActiveConnection:=conn1

'TRUE bedeutet Sperrung, FALSE bedeutet keine Sperrung
On Error GoTo Err_ExitFrm_Click
Do Until RS.EOF = True
strPath = RS.Fields(strRowPath)
boolGrAcc = RS.Fields(strRowGrAcc)
With conn2
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strPath
.Open
End With
If boolGrAcc = True Then
With conn2
.Properties("AllowBypassKey") = False
.Close
End With
Else: With conn2
.Properties("AllowBypassKey") = True
.Close
End With
End If
RS.MoveNext
Loop

DoCmd.Quit

Exit_ExitFrm_Click:
Set RS = Nothing
Set conn1 = Nothing
Set conn2 = Nothing
Exit Sub

Err_ExitFrm_Click:
MsgBox "Fehler " & Err.Number & ": " & Err.Description
Resume Exit_ExitFrm_Click

End Sub

Wenn ich da zu kompliziert oder völlig daneben ran gehe bitte Bescheid sagen. Ich hoffe mir kann jemand helfen.
Vielen Dank schon mal im Voraus:)
MfG Mathis

Josef P.
30.05.2012, 18:27
Hallo!

In einer mdb/accdb ist AllowBypassKey meiner Meinung nach nicht in den Properties einer ADODB.Connection bzw. CurrentProject enthalten. Das ist eine DAO.Database-Eigenschaft.

Beispiel-Code: FAQ 1.8 Verhindern der Shift-Taste beim Start (http://www.donkarl.com?FAQ1.8)
Diesen Code musst du für den Zugriff auf die "fremden" Datenbanken nur etwas anpassen.
Statt
Set db = CurrentDb
kannst du
set db = dbengine.Opendatabase("...")
verwenden. Im Code sollte dann allerdings die Datenbank per db.Close auch wieder geschlossen werden.

Oder (meiner Ansicht nach eleganter):
EnableShift um einen Database-Parameter erweitern.
Beispiel:
Sub EnableShift(blnFlag As Boolean, optional db as dao.database = nothing)

'<s>Dim db As DAO.Database</s>
Dim prp As DAO.Property

if db is nothing then
Set db = CurrentDb
end if

...

Beim Aufruf die passende Database-Instanz übergeben
dim db as dao.database
set db = dbengine.opendatabase(...)
EnableShift true, db
db.close

BTW:
Ein ähnliches Skript könnte man auch mit VB-Skript erstellen und per Kontextmenü im Windows-Explorer für eine accdb/mdb/... verwenden.

mfg
Josef

Anne Berg
30.05.2012, 18:51
Hallo,

handelt es sich um ADPs oder wieso hantierst du da mit ADO?

Abgesehen davon, ob das überhaupt so möglich ist, könnte dieser AbschnittDo Until RS.EOF = True
strPath = RS.Fields(strRowPath)
boolGrAcc = RS.Fields(strRowGrAcc)
With conn2
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strPath
.Open
End With
If boolGrAcc = True Then
With conn2
.Properties("AllowBypassKey") = False
.Close
End With
Else: With conn2
.Properties("AllowBypassKey") = True
.Close
End With
End If
RS.MoveNext
Loopdeutlich kürzer gestaltet werden: Do Until rs.EOF = True
strPath = rs.Fields(strRowPath)
boolGrAcc = rs.Fields(strRowGrAcc)
With conn2
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strPath
.Open
.Properties("AllowBypassKey") = Not boolGrAcc
.Close
End With
rs.MoveNext
Loop
Interesssant wäre noch zu wissen, an welcher Stelle der Fehler auftritt. Diese Information hättest du gleich mitliefern sollen.
Ich vermute mal, eine Connection kennt keine Property "AllowBypassKey".

Die nächste Frage wäre, warum du die Eigenschaft bei allen möglichen Datenbanken auf einen Rutsch einstellen willst.
Wäre es nicht sinnvoller, dies von Fall zu Fall auf eine bestimmte DB bezogen zu tun?

Übrigens: Bei TommyK sollte sich eine fertige Lösung hierzu finden lassen.

Mathis
30.05.2012, 20:06
Hallo Anne, hallo Josef,

vielen Dank für die schnellen Antworten, ich werde die Tipps gleich Morgen umsetzen. Ich melde mich dann nochmal.
@Anne: dann beantworte ich auch deine Fragen, ich arbeite noch nicht lange mit ADO und mit DAO habe ich noch gar nichts gemacht (muss mir erstmal meine Notizen ansehen)

Dankeschön:)

Anne Berg
30.05.2012, 20:22
Hallo.In einer mdb/accdb ist AllowBypassKey meiner Meinung nach nicht in den Properties einer ADODB.Connection bzw. CurrentProject enthalten.
Ich hatte hierzu folgendes in der Access-Hilfe gefunden:Um die AllowBypassKey-Eigenschaft mit Hilfe eines Makros oder von Visual Basic festzulegen, stellen Sie zunächst entweder die Eigenschaft einmalig im Dialogfeld Start ein oder Sie erstellen die Eigenschaft auf einer der folgenden Arten:

- In einer Microsoft Access-Datenbank (.mdb) können Sie die Eigenschaft mit der CreateProperty-Methode hinzufügen und anschließend der Properties-Auflistung des Database-Objekts anhängen.
- In einem Microsoft Access-Projekt (.adp) können Sie die Eigenschaft der AccessObjectProperties-Auflistung des CurrentProject-Objekts unter Verwendung der Add-Methode anhängen.
Daher meine Frage nach der ADP. Das zu beurteilen überlasse ich lieber anderen.

Josef P.
30.05.2012, 20:51
Hallo!

Das zu beurteilen überlasse ich lieber anderen.
Ich weiß zwar nicht, worauf du damit genau anspielen willst, aber ich entnehme dem Hilfe-Text, dass in einer ADP-Datei die Eigenschaft AllowBypassKey in den CurrentProjekt-Properties und in einer accdb/mdb in den Database-Properties enthalten ist.
Da für die ADODB-Connection ein Jet-OLEDB-Provider verwendet wird, scheint es keine ADP-Datei zu sein. Falls das zutrifft, wird das Erzeugen der AllowBypassKey in einer ADODB-Connection bzw. bei CurrentProject einer mdb/accdb kein Auswirkung zeigen.

mfg
Josef

Mathis
14.06.2012, 15:44
Hallo,

bitte entschuligt die lange Wartezeit. Dank euch habe ich mein Problem lösen können. Ich habe dann die DAO-Variante genutzt und jetzt funktioniert alles wie es soll.
@Anne: Ich weiß auch nicht genau wieso ich jedes Mal alle Datenbanken anpassen wollte, war jedenfalls Quatsch.

Falls es jemanden interessiert ist hier die Umsetzung der der Lösungsvorschläge:

Private Sub Sperrung_Datenansicht_AfterUpdate()
Dim strQryThisDB As String
Dim strRowGrAcc As String
Dim strRowTSPath As String
Dim db As DAO.Database
Dim RS As DAO.Recordset
Dim prp As DAO.Property
Dim boolGrAcc As Boolean
Dim strTSPath As String
Dim boolFrmGrAcc As Boolean

On Error GoTo Err_Sperrung_Datenansicht_AfterUpdate

strQryThisDB = "Sperre_aktuellle_DB_A"
strRowGrAcc = "Sperrung_Datenansicht"
strRowTSPath = "Dateipfad_TS"
boolFrmGrAcc = Me!Sperrung_Datenansicht

Set db = CurrentDb
Set RS = db.OpenRecordset(strQryThisDB)
strTSPath = RS.Fields(strRowTSPath)
RS.Close

If strTSPath = Me!Dateipfad_TS Then
'Property mit Negation des übergebenen Parameters belegen
db.Properties!AllowBypassKey = Not boolFrmGrAcc
db.Close
Else: db.Close
Set db = DBEngine.OpenDatabase(Me!Dateipfad)
db.Properties!AllowBypassKey = Not boolFrmGrAcc
db.Close
End If

Exit_Sperrung_Datenansicht_AfterUpdate:
Set RS = Nothing
Set db = Nothing
Set prp = Nothing
Exit Sub

Err_Sperrung_Datenansicht_AfterUpdate:
'Property erzeugen, falls noch nicht vorhanden
If Err = 3270 Then
Set prp = db.CreateProperty("AllowBypassKey", dbBoolean, Not boolFrmGrAcc)
db.Properties.Append prp
Resume Next
Else: MsgBox "Fehler " & Err.Number & ": " & Err.Description
Resume Exit_Sperrung_Datenansicht_AfterUpdate
End If

End Sub

Vielen Dank für die schnelle Hilfe
MfG Mathis :)