In einem früheren Beitrag haben wir mit einer Funktion geprüft, ob eine Datenbank geöffnet ist. Diese war jedoch nicht in jedem Fall zuverlässig – also liefern wir eine neue Version für eine solche Funktion. In dieser neuen Funktion versuchen wir, die Datenbank exklusiv zu öffnen. Das gelingt nur, wenn diese aktuell nicht geöffnet ist. Mehr dazu im vorliegenden Beitrag!
In der Funktion namens IsDatabaseOpen, die wir im Beitrag Kunde zu einer E-Mail öffnen (www.access-im-unternehmen.de/1291) vorgestellt haben, prüfen wir nur, ob sich im gleichen Verzeichnis der Datenbank auch eine .laccdb-Datei befindet. Diese wird normalerweise erstellt, wenn die Datenbank geöffnet ist.
Carsten Gromberg hat uns darauf hingewiesen, dass diese Funktion nicht immer das korrekte Ergebnis liefert und eine verbesserte Version der Funktion beigesteuert.
Dabei verwenden wir einen zuverlässigeren Weg, um zu prüfen, ob eine Datenbank geöffnet ist. Dabei versuchen wir, die Datenbank exklusiv zu öffnen. Das ist nur möglich, wenn die Datenbank bisher gar nicht geöffnet ist.
Die neue Version der Funktion IsDatabaseOpen finden Sie in Listing 1. Die Funktion erwartet den Pfad zu der zu untersuchenden Datenbankdatei sowie einen Boolean-Parameter, der angibt, ob bei bereits geöffneter Datenbank eine Meldung ausgegeben werden soll.
Public Function IsDatabaseOpen(ByVal strDBName As String, _ Optional ByVal bolShowMessage As Boolean) As Boolean Dim objEngine As DAO.PrivDBEngine Set objEngine = New DAO.PrivDBEngine On Error Resume Next objEngine.OpenDatabase strDBName, True, True If Not Err.Number = 0 Then IsDatabaseOpen = True End If If IsDatabaseOpen And bolShowMessage Then MsgBox strDBName & vbCrLf _ & "kann nicht exklusiv geöffnet werden!" & vbCrLf & vbCrLf _ & "Fehler: " & CStr(Err.Number) & vbCrLf _ & Err.Description, vbExclamation End If Set objEngine = Nothing End Function