• Opcje startowe MS Access

Zazwyczaj w bazie danych przekazanej użytkownikowi końcowemu ukrywa się główne okno bazy danych programu MS Access, aby uniemożliwić mu przeglądanie struktury bazy, danych zawartych w tabelach i zwracanych przez kwerendy, przypadkowych (bądź specjalnych) zmian danych, usunięcia bądź zmiany nazw obiektów itp. Aby uniknąć tego typu problemów powinniśmy zapewnić użytkownikowi („użyszkodnikowi”) dostęp do danych za pomocą tzw. interfejsu użytkownika, opartego na różnego rodzaju formularzach.
Samo ukrycie okna nawigacji (okna bazy danych), poprzez odznaczenie pola wyboru „Wyświetl okienko nawigacji” za pomocą polecenia Menu/Plik/Opcje/ Bieżąca baza danych/Nawigacja

niewiele daje, gdyż użytkownik może wybrać polecenie Menu/Plik/Opcje/

i w otwartym oknie „Opcje programu Access” wybrać kategorię: Bieżąca baza danych/Nawigacja, zaznaczyć pole wyboru „Wyświetl okienko nawigacji”, ponownie uruchomić (zdefragmentować) bazę i cieszyć się widokiem okienka nawigacji (okna bazy danych). Użytkownik może także uruchomić bazę trzymając wciśnięty klawisz „Shift” i dokonać zmian w Opcjach startowych bazy. Po normalnym uruchomieniu bazy, użytkownik może odsłonić panel nawigacji (okno bazy) za pomocą klawisza F11, jak również wykorzystać inne klawisze specjalne programu MS Access (patrz tabelka poniżej), by zaglądnąć tam, gdzie nie powinien.

Sekwencja klawiszy	Skutek
F11	Wyświetlenie okna bazy danych na wierzchu
CTRL+G	Wyświetlenie okna analizy programu
CTRL+F11	Przełączanie pomiędzy niestandardowym paskiem menu i wbudowanym paskiem menu
ALT+F11	Wyświetlenie okna edytora VBA
CTRL+BREAK	Wprowadzenie trybu przerwania i wyświetlenie bieżącego modułu w oknie modułu
SHIFT	Wciśnięcie podczas startu bazy umożliwia pominięcie opcji startowych tzn. makro Autoexec i formularz startowy nie będą uruchamiane.

• Opcje startowe aplikacji MS Access

Prawie wszystkie opcje dostępne w oknie dialogowym „Opcje programu Access” można zmieniać za pomocą kodu VBA. W większości przypadków, o ile właściwość CurrentDbProperties("PropertyName") nie została ustawiona w oknie dialogowym „Opcje programu Access”, to właściwość nie istnieje w zbiorze Properties obiektu Application i próba odwołania się do nieistniejącej właściwości

' sprawdź, czy istnieje właściwość sPrpName
IsObject (CurrentDb.Properties(sPrpName))

powoduje wygenerowanie błędu nr 3270 - „Nie odnaleziono właściwości”. Błąd ten (nr 3270) musimy przechwycić, a w obsłudze błędu utworzyć żądana właściwość i dodać ją do kolekcji CurrentDb.Properties
Do ustawienia każdej z tych właściwości służy metoda SetOption obiektu Application, lub właściwość CurrentDb.Properties(sPropertyName) = vPropertyValue, a do pobierania bieżącej wartości metoda GetOption lub właściwość CurrentDb.Properties(sPropertyName). Składnia wygląda następująco:

Application.SetOption sPropertyName, vPropertyValue
CurrentDb.Properties(sPropertyName) = vPropertyValue

gdzie sPropertyName jest jedną z nazw z poniższej tabeli, a vPropertyValue wartością, której typ musi być zgodny z typem danych właściwości. W większości przypadków, o ile właściwość nie została już ustawiona w oknie dialogowym „Opcje programu Access”, nie jest ona dołączona do zbioru Properties obiektu Application.

Opcja	Właściwość do ustawienia	Typ danych
Tytuł aplikacji	AppTitle	dbText
Ikona aplikacji	AppIcon	dbText
Wyświetl formularz	StartupForm	dbText
Wyświetl okno bazy danych	StartupShowDBWindow	dbBoolean
Wyświetl pasek stanu	StartupShowStatusBar	dbBoolean
Wyświetl pasek menu	StartupMenuBar	dbText
Pasek menu skrótów	StartupShortcutMenuBar	dbText
Zezwalaj na pełne menu	AllowFullMenus	dbBoolean
Zezwalaj na domyślne menu skrótów	AllowShortcutMenus	dbBoolean
Zezwalaj na wbudowane paski narzędzi	AllowBuiltInToolbars	dbBoolean
Zezwalaj na zmiany w paskach narzędzi	AllowToolbarChanges	dbBoolean
Zezwalaj na wyświetlenie kodu po wystąpieniu błędu	AllowBreakIntoCode	dbBoolean
Użyj specjalnych klawiszy programu Access	AllowSpecialKeys	dbBoolean
Nazwa wstążki (Ribbon)	CustomRibbonID	dbText
Zezwalaj na użycie klawisza Shift do ominięcia opcji startowych	AllowBypassKey	dbBoolean
AllowBypassKey nie jest właściwością wbudowaną do bazy danych Accessa. Aby z niej korzystać, należy ją utworzyć, dołączyć do kolekcji Properties i ustawić jej wartość.

No to spróbujmy zabezpieczyć bazę danych tak, by ograniczyć użytkownikowi do minimum możliwość ingerowania w strukturę i dane naszej bazy danych.

Option Compare Database
Option Explicit
 
 ' • Public Function ChangeProperty( _
 '                            sPropertyName As String, _ 
 '                            vPropertyType As Variant, _ 
 '                            vPropertyValue As Variant) As Boolean 
 ' ------------------------------------------------------------------
 ' autor: Zbigniew Bratko - 03.2016

 ' [sPropertyName] - nazwa właściwości bazy danych
 ' [vPropertyType] - typ właściwości sPropertyName,
 ' [vPropertyValue] - wartość na jaką ma zostać ustawiona właściwość sPropertyName,
 '
 ' [Out] - przy powodzeniu zwraca TRUE, przy niepowodzeniu FALSE
 '

Public Function ChangeProperty( _
                            sPropertyName As String, _
                            vPropertyType As Variant, _
                            vPropertyValue As Variant) As Boolean
Dim dbs As DAO.Database
Dim prp As DAO.Property
Const cPropertyNotFound As Long = 3270
On Error GoTo ErrHandler
  
  Set dbs = Application.CurrentDb
    ' spróbuj ustawić wartość właściwości,
    ' jeżeli właściwość nie istnieje, wygenerowany zostanie błąd nr 3270
    ' i właściwość zostanie utworzona w obsłudze błędu
    dbs.Properties(sPropertyName) = vPropertyValue

  ChangeProperty = True

ExitHere:
  ' zniszcz zmienną obiektową
  Set dbs = Nothing
  Exit Function
ErrHandler:
  If Err.Number = cPropertyNotFound Then
    ' właściwość nie istnieje,
    With dbs
      ' utwórz właściwość o określonym typie i wartości początkowej
      Set prp = .CreateProperty(sPropertyName, vPropertyType, vPropertyValue)
        'dodaj właściwość do kolekcji
        .Properties.Append prp
        'odśwież kolekcję Properties
        .Properties.Refresh
        ' zniszcz zmienną obiektową
        Set prp = Nothing
      End With
    Resume Next
  Else
    MsgBox "Nieoczekiwany błąd nr " & Err.Number & "." & vbNewLine & Err.Description
    ChangeProperty = False
    Resume ExitHere
  End If

End Function


' przykładowa funkcja zmieniająca opcje startowe MS Access
Public Function LockDatabase()
Dim fRet As Boolean

  ' ustawienia obowiązują dopiero po ponownym uruchomieniu bazy
  fRet = ChangeProperty("AppTitle", dbText, "Moja baza")
  fRet = ChangeProperty("StartupForm", dbText, "frmMojFormularz")
  fRet = ChangeProperty("StartUpShowDBWindow", dbBoolean, False)
  fRet = ChangeProperty("AllowFullMenus", dbBoolean, False)
  fRet = ChangeProperty("AllowShortcutMenus", dbBoolean, False)
  ' AllowBuiltInToolbars=TRUE, ponieważ nie zadziała instrukcja obiektu DoCmd
  ' ukrywająca wstążkę: DoCmd.ShowToolbar "Ribbon", acToolbarNo
  fRet = ChangeProperty("AllowBuiltInToolbars", dbBoolean, TRUE)
  fRet = ChangeProperty("AllowToolbarChanges", dbBoolean, False)
  fRet = ChangeProperty("AllowBreakIntoCode", dbBoolean, False)
  fRet = ChangeProperty("AllowSpecialKeys", dbBoolean, False)
  fRet = ChangeProperty("AllowBypassKey", dbBoolean, False)
  fRet = ChangeProperty("StartupShowStatusBar", dbBoolean, False)

End Function

Funkcję LockDatabase() należy wywołać za pomocą makra AutoExec Action = "RunCode"; Argument = "ChangeProperty()" lub np. w zdarzeniu OnLoad() formularza startowego.

Ale dalej mamy problem z ukryciem panelu nawigacji (okna bazy). Co prawda, menu Plik jest mocno okrojone (tylko trzy polecenia Menu), ale użytkownik może wybrać polecenie Menu/Plik/Opcje prywatności/ i w otwartym oknie „Opcje programu Access” wybrać kategorię: Bieżąca baza danych/Nawigacja, zaznaczyć pole wyboru „Wyświetl okienko nawigacji” oraz pozmieniać inne opcje, ponownie uruchomić (zdefragmentować) bazę i uzyskać dostęp do okienka nawigacji (okna bazy danych) i innych obiektów bazy.

Nie tylko polecenie Menu/Plik/Opcje prywatności umożliwia użytkownikowi zmianę opcji startowych bazy danych. Także Pasek narzędzi Szybki dostęp pozwala na bezproblemowe dostanie się do okna dialogowego „Opcje programu Access”.

Wystarczy wybrać polecenie Dostosuj pasek narzędzi Szybki dostęp i następnie pozycję Więcej poleceń... by otworzyć okno dialogowe „Opcje programu Access” i tam zmienić wybrane opcje.

Umieszczony na Pasku narzędzi Szybki dostęp przycisk „Visual Basic (Alt+F11)” umożliwia otwarcie edytora Visual Basic i przeglądanie całego kodu VBA.

Umieszczony na Pasku narzędzi Szybki dostęp przycisk „Opcje programu Access” umożliwiają otwarcie okna„Opcje programu Access”.
Jak widać, w dalszym ciągu występują problemy z ukryciem okna nawigacji (dla MS Access wersja 2007+) lub okna bazy danych (dla MS Access wersja 2003-). To co jest proste w MS Access 2003 i wersjach niższych, nie jest tak oczywiste dla późniejszych wersji MS Access w których pojawia się okno nawigacji (ang. Navigation Pane), Pasek narzędzi Szybki dostęp (ang. Quick Access Toolbar), nowa właściwość Nazwa niestandardowej wstążki (ang. CustomRibbonID), a także Wstążki (ang. Ribbons), zamiast dawnych pasków narzędzi i wiele innych, mniej lub bardziej ważnych elementów. Nie wspomnę o problemach pobierania uchwytów okien, nazw klas i wielu innych problemach związanych z VBA7.

Ale o tym, być może kiedyś.

• Funkcje API - właściwość Err.LastDllError

W poprzednim artykule • Funkcje API - Mutex, jedna instancja bazy MS Access • zasygnalizowałem problem zbyt lakonicznego komunikatu w przypadku niepowodzenia podczas wywołania funkcji API CreateMutex(...). Komunikat typu:

MsgBox "Nieprzewidziany błąd wywołania biblioteki DLL." & vbNewLine & _
Numer błędu: " & Err.LastDllError

wydaje się być dość zdawkowy i nie daje końcowemu użytkownikowi zbyt wiele informacji o przyczynie błędu.
Spróbuję przedstawić rozwiązania pokazujące, jak w przypadku wystąpienia błędu zewnętrznej biblioteki DLL, przekonwertować „suchy numer” błędu Err.LastDllError na opisowy komunikat tekstowy, odnoszący się do zaistniałego błędu.
Zrobię to na przykładzie wywołania funkcji API • GetFileAttributes(...), która przy powodzeniu zwraca atrybuty pliku lub katalogu, a przy niepowodzeniu zwraca wartość INVALID_FILE_ATTRIBUTES = -1.
Bardziej szczegółowe informacje o przyczynach niepowodzenia wywołania funkcji, możemy uzyskać z opisu kodu błędu systemowego wygenerowanego przy wywołaniu biblioteki dołączanej dynamicznie (DLL). Kod błędu systemowego możemy pobrać dzięki właściwości Err.LastDllError.

• Opis błędu o kodzie odpowiadającym właściwości Err.LastDllError

Najpierw musimy zadeklarować funkcję API • GetFileAttributes(...), a następnie spróbować wywołać ją z nieprawidłowym argumentem, tak by wywołanie funkcji • GetFileAttributes(...) zakończyło się niepowodzeniem, w wyniku czego funkcja zwróci wartość INVALID_FILE_ATTRIBUTES = -1), a właściwość Err.LastDllError zwróci nam systemowy kod błędu wywołania biblioteki DLL.

Option Compare Database
Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function GetFileAttributes Lib "kernel32" _
          Alias "GetFileAttributesA" _
          (ByVal lpFileName As String) As Long
#Else
  Private Declare Function GetFileAttributes Lib "kernel32" _
          Alias "GetFileAttributesA" _
          (ByVal lpFileName As String) As Long
#End If


' przykładowe wywołania
Public Function MojTest()
Dim lAttrib As Long

   ' próba pobrania atrybutów pliku, który nie istnieje
   lAttrib = GetFileAttributes("C:\NotExistingFile")
   If lAttrib = INVALID_FILE_ATTRIBUTES Then Debug.Print "A - Err = "; Err.LastDllError
   
   ' próba pobrania atrybutów pliku w nieistniejącej lokalizacji (brak stacji dysków B:\)
   lAttrib = GetFileAttributes("B:\MojPlik.txt")
   If lAttrib = INVALID_FILE_ATTRIBUTES Then Debug.Print "B - Err = "; Err.LastDllError
    
   ' próba pobrania atrybutów pliku z błędnie wpisanej lokalizacji
   lAttrib = GetFileAttributes(":MojPlik.txt")
   If lAttrib = INVALID_FILE_ATTRIBUTES Then Debug.Print "C - Err = "; Err.LastDllError
     
   ' próba pobrania atrybutów pliku z pustego dysku DVD (CD)
   lAttrib = GetFileAttributes("Z:\NotExistingFile")
   If lAttrib = INVALID_FILE_ATTRIBUTES Then Debug.Print "D - Err = "; Err.LastDllError
      
   ' próba pobrania atrybutów pliku z pustej stacji DVD (CD)
   lAttrib = GetFileAttributes("Z:\MojPlik.txt")
   If lAttrib = INVALID_FILE_ATTRIBUTES Then Debug.Print "E - Err = "; Err.LastDllError
      
    DoCmd.RunCommand acCmdDebugWindow
    
End Function

Po wywołaniu przykładowej funkcji MojTest() w oknie „Immediate” możemy zobaczyć wyniki:

Nie wiem jak innym, ale mi cyferki (liczby) typu: 2, 3, 123, 1, 21 nic nie mówią. Tym bardziej użytkownikowi, który zobaczy poniższy komunikat:

Aby dowiedzieć się czegoś więcej o przyczynie błędu wywołania funkcji DLL, wykorzystamy funkcję API:
• FormatMessage(...), która formatuje tekst komunikatu związanego z kodem błędu wywołania biblioteki DLL i zapisuje sformatowany komunikat do bufora wyjściowego. Zwraca ilość znaków zapisanych w buforze wyjściowym, (nie uwzględnienia znaku końca ciągu vbNullChar).

Option Compare Database
Option Explicit

' • Function LastDllErrorDescr(lNoLastError As Long,[sFunctionName As String = ""]) As String
' --------------------------------------------------------------------------------------
' autor: Zbigniew Bratko - 03.2016
' Zwraca sformatowany tekst komunikatu związany z kodem błędu wywołania biblioteki DLL
' [lNoLastError] - numer błędu wywołania funkcji DLL, odpowiadający właściwości Err.LastDllError
' [sFunctionName] - opcjonalny argument odnoszący się do funkcji w której wystąpił błąd
' [OUT] - Przy powodzeniu zwraca tekst komunikatu związany z kodem błędu wywołania biblioteki DLL,
'         przy niepowodzeniu (braku opisu błędu) zwraca informację: "Nie znaleziono opisu błędu."
'

#If VBA7 Then
  Private Declare PtrSafe Function FormatMessage Lib "kernel32" _
          Alias "FormatMessageA" _
          (ByVal dwFlags As Long, _
          lpSource As Any, _
          ByVal dwMessageId As Long, _
          ByVal dwLanguageId As Long, _
          ByVal lpBuffer As String, _
          ByVal nSize As Long, _
          Arguments As LongPtr) As Long
#Else
  Private Declare Function FormatMessage Lib "kernel32" _
          Alias "FormatMessageA" _
          (ByVal dwFlags As Long, _
          lpSource As Any, _
          ByVal dwMessageId As Long, _
          ByVal dwLanguageId As Long, _
          ByVal lpBuffer As String, _
          ByVal nSize As Long, _
          Arguments As Long) As Long
#End If

Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const INVALID_FILE_ATTRIBUTES = -1
Private Const cDescrNotExist As String = "Nie znaleziono opisu błędu."


' Funkcja własna LastDllErrorDescr
Public Function LastDllErrorDescr(lNoLastError As Long, _
                        Optional sFunctionName As String = "") As String
Dim sBufferMessage As String
Dim lLenMessage As Long
Const cBufferSize As Long = 256
  
  ' przygotuj bufor na przyjęcie komunikatu o błędzie
  sBufferMessage = String(cBufferSize, vbNullChar)
  ' zapisz tekst komunikatu do bufora sBufferMessage
  lLenMessage = FormatMessage(ByVal FORMAT_MESSAGE_FROM_SYSTEM, _
                      0&, _
                      ByVal lNoLastError, _
                      0&, _
                      ByVal sBufferMessage, _
                      ByVal cBufferSize, _
                      0)
  
  ' nie znaleziono opisu błędu
  If lLenMessage = 0 Then
    ' przygotuj własny komunikat
    sBufferMessage = cDescrNotExist
    lLenMessage = Len(sBufferMessage)
  End If
  
  ' pobierz tekst komunikatu z bufora
  If Len(sFunctionName) = 0 Then
    LastDllErrorDescr = Left$(sBufferMessage, lLenMessage)
  Else
    LastDllErrorDescr = "Błąd nr " & lNoLastError & vbNewLine & _
                        "Funkcja " & sFunctionName & vbNewLine & _
                        "Opis błędu: " & vbNewLine & _
                        Left$(sBufferMessage, lLenMessage)
  End If

End Function

' przykładowe wywołania
Public Function MojTestBis()
Dim lAttrib As Long

  ' próba pobrania atrybutów pliku, który nie istnieje
  lAttrib = GetFileAttributes("C:\NotExistingFile")
  If lAttrib = INVALID_FILE_ATTRIBUTES Then
    Debug.Print "A - Err = "; Err.LastDllError & "  " & LastDllErrorDescr(Err.LastDllError)
  End If
  
  ' próba pobrania atrybutów pliku w nieistniejącej lokalizacji (brak stacji dysków B:\)
  lAttrib = GetFileAttributes("B:\MojPlik.txt")
  If lAttrib = INVALID_FILE_ATTRIBUTES Then
    Debug.Print "B - Err = "; Err.LastDllError & "  " & LastDllErrorDescr(Err.LastDllError)
  End If
  
  ' próba pobrania atrybutów pliku z błędnie wpisanej lokalizacji
  lAttrib = GetFileAttributes(":MojPlik.txt")
  If lAttrib = INVALID_FILE_ATTRIBUTES Then
    Debug.Print "C - Err = "; Err.LastDllError & "  " & LastDllErrorDescr(Err.LastDllError)
  End If
  
  ' próba pobrania atrybutów pliku z pustego dysku DVD (CD)
  lAttrib = GetFileAttributes("Z:\NotExistingFile")
  If lAttrib = INVALID_FILE_ATTRIBUTES Then
    Debug.Print "D - Err = "; Err.LastDllError & "  " & LastDllErrorDescr(Err.LastDllError)
  End If
  
  ' próba pobrania atrybutów pliku z pustej stacji DVD (CD)
  lAttrib = GetFileAttributes("Z:\MojPlik.txt")
  If lAttrib = INVALID_FILE_ATTRIBUTES Then
    Debug.Print "E - Err = "; Err.LastDllError & "  " & LastDllErrorDescr(Err.LastDllError)
  End If
  
  DoCmd.RunCommand acCmdDebugWindow
  
End Function

Po wywołaniu przykładowej funkcji MojTestBis() w oknie „Immediate” możemy zobaczyć wyniki:

Uwaga: Właściwość Err.LastDllError odnosi się tylko do wywołania funkcji z zewnętrznych bibliotek DLL z kodu programu pisanego w języku VBA. Tak wywoływana funkcja zwykle zwraca kod oznaczający, czy wywoływana funkcja zakończyła się sukcesem, czy też niepowodzeniem i ustawiana jest właściwość Err.LastDllError. Właściwość Err.LastDllError powinna być sprawdzana po każdym niepowodzeniu wywoływanej funkcji biblioteki DLL. Jeśli właściwość Err.LastDllError została ustawiona,  nie jest zgłaszany żaden wyjątek .

• Funkcje API - Jedna instancja bazy MS Access

Czasami projekt bazy danych wymaga, (z takich, czy innych względów), by użytkownik nie mógł otworzyć drugiej instancji bieżącej bazy danych. Sposobów zabezpieczenia się (a raczej pseudozabezpieczenia) przed otwarciem drugiej instancji bieżącej bazy jest kilka, jeśli nie kilkanaście. Generalnie wszystkie metody będą działały w oparciu o opcje startowe MS Access:

• Akcja makro Autoexec

Makro jest uruchamiane automatycznie podczas startu MS Access. Za pomocą funkcji uruchamianej przez to makro dokonujemy "pseudozabezpieczeń". Możemy również otworzyć jakiś formularz (może być ukryty), który będzie ... patrz punkt niżej:

Właściwość: StartupForm

Podczas startu MS Access automatycznie otwierany jest formularz startowy: StartupForm = „Nazwa formularza startowego” w którym np. w zdarzeniu OnLoad uruchamiamy funkcję, która tworzy "pseudozabezpieczenie"

Obie te opcje startowe można pominąć, otwierając bazę danych trzymając wciśnięty klawisz „Shift”. Ale z pomocą przychodzi właściwość AllowBypassKey, za pomocą której możemy uniemożliwić używanie klawisza SHIFT dla opcji startowych. Tak przy okazji, w celu dodatkowego zabezpieczeni możemy skorzystać z właściwości AllowSpecialKeys za pomocą której możemy uniemożliwić korzystanie użytkownikowi ze specjalnych klawiszy programu MS Access

Sekwencja klawiszy	Skutek
F11	Wyświetlenie okna bazy danych na wierzchu
CTRL+G	Wyświetlenie okna analizy programu
ALT+F11	Wyświetlenie okna edytora VBA
CTRL+F11	Przełączanie pomiędzy niestandardowym paskiem menu i wbudowanym paskiem menu
CTRL+BREAK	Wprowadzenie trybu przerwania i wyświetlenie bieżącego modułu w oknie modułu
SHIFT	Wciśnięcie podczas startu bazy umożliwia pominięcie opcji startowych tzn. makro Autoexec i formularz startowy nie są uruchamiane.

• Pseudozapezpieczenia

• Zapis pliku na dysku

Pierwszym, narzucającym się rozwiązaniem jest zapisanie „gdzieś” na dysku, podczas startu bazy, małego pliku tekstowego, takie niby „cookies”, który będzie usuwany przy zamknięciu bazy danych. Podczas startu bazy danych, z poziomu makra Autoexec lub formularza startowego, uruchomiana będzie „Jakas_Funkcja” sprawdzającej obecność pliku. Jak plik istnieje, to zostanie wywołana metoda Application.Quit dla nowo otwieranej instancji bazy.

' przykładowy kod
If Len(Dir("Sciezka_MojPlik")) > 0 Then
  ' plik istnieje, zamknij otwieraną bazę
  MsgBox "Nie możesz uruchomić następnej bazy danych"
  Application.Quit
End If

No niby tak, ale jeżeli zawiesi się System (baza), wtedy plik "Sciezka_MojPlik" nie zostanie usunięty z dysku, i przy następnym uruchomieniu naszej bazy możemy mieć poważne kłopoty. Plik istnieje (i będzie istniał, aż do jego usunięcia), więc może się zdarzyć tak, że zawsze będzie QUIT.

• Tylko jedna instancja MS Access

Innym sposobem jest sprawdzenie podczas uruchomienia bazy danych, czy inna instancja MS Access jest otwarta. W tym celu możemy skorzystać z funkcji własnej CountAccessInstances(...) przedstawionej w art. • Funkcje API - ile uruchomiono instancji MS Access •. Jeżeli funkcja zwróci wartość > 1, wtedy nie pozwalamy na uruchomienie bazy.

' przykładowy kod
If CountAccessInstances > 1 Then
  MsgBox "Nie możesz uruchomić następnej bazy danych"
  ' zamknij otwieraną bazę
  Application.Quit
End If

Niestety, to rozwiązanie ma jeden wielki minus. W ten sposób uniemożliwimy użytkownikowi otwarcie jakiejkolwiek innej bazy danych, gdy otwarta jest „ta nasza jedyna baza”.

• Tylko jedna instancja bieżącej bazy MS Access

Aby umożliwić użytkownikowi otwarcie innych baz, z wyłączeniem drugiej instancji bieżącej bazy danych, musimy podczas uruchamiania bazy sprawdzić, czy nie została wcześniej otwarta pierwsza instancja bazy. W tym celu skorzystamy z funkcji własnej GetTextWindow(...) przedstawionej w art.  • Funkcje API - jak pobrać tytuł (tekst) okna • w celu pobrania tytułu (tekstu) okna MS Access otwieranej bazy danych oraz (tak jak w poprzednim przykładzie), z funkcji własnej CountAccessInstances(...) przedstawionej w art. • Funkcje API - ile uruchomiono instancji MS Access • w celu pobrania ilości okien MS Access o tytule (tekście) zwróconym przez funkcję własną GetTextWindow(...).

' przykładowy kod  
Dim sCurrDbTitle As String

' pobierz tytuł okna MS Access bieżącej bazy
sCurrDbTitle = GetTextWindow(Application.hWndAccessApp)
' pobierz ilość otwartych instancji MS Access o tytule okna sCurrDbTitle
If CountAccessInstances(sCurrDbTitle) > 1 Then
  MsgBox "Nie możesz uruchomić drugiej instancji bieżącej bazy danych!"
  ' zamknij otwieraną bazę
  Application.Quit
End If

Niestety, to rozwiązanie też ma swoje wady. Jeżeli baza danych nie ma ustawionej właściwości CurrentDb.Properties("AppTitle"), którą to właściwość można ustawić za pomocą: Menu Plik/Opcje/Bieżąca baza danych/Opcje aplikacji/Tytuł Aplikacji, to tytuł okna MS Access zmienia się, wraz ze zmianą wersji MS Access.

Przykładowo dla bazy testowej: C:\tmp\dbTest.accdb
MS Access 2016 - "Access — dbTest : Baza danych- C:\tmp\dbTest.accdb (format pliku programu Access 2007–2016)"
MS Access 2010 - "Microsoft Access — dbTest : Baza danych (Access 2007 - 2010)"
MS Access 2007 - "Microsoft Access — dbTest : Baza danych (Access 2007)"
Jeżeli wymogiem dla prawidłowego działania kodu jest konieczność ustawienia właściwości CurrentDb.Properties("AppTitle") to nie musimy korzystać z funkcji własnej GetTextWindow(...), tytuł okna MS Access pobierzemy dzięki właściwości CurrentDb.Properties("AppTitle").

' przykładowy kod  
Dim sCurrDbTitle As String

' pobierz tytuł okna MS Access bieżącej bazy
sCurrDbTitle = CurrentDb.Properties("AppTitle")
' pobierz ilość otwartych instancji MS Access o tytule okna sCurrDbTitle
If CountAccessInstances(sCurrDbTitle) > 1 Then
  MsgBox "Nie możesz uruchomić drugiej instancji bieżącej bazy danych!"
  ' zamknij otwieraną bazę
  Application.Quit
End If

• Inne rozwiązania

Innym rozwiązaniem jest uruchomienie „jakieś funkcji”, która będzie pilnowała, by otwarta była jedna instancja bieżącej bazy danych. Innymi słowy „Jakaś funkcja” musi być uruchomiona podczas startu bazy danych i przez cały czas działania bazy musi sprawdzać, czy nie została otwarta druga instancja bieżącej bazy danych. Najprostszym rozwiązaniem jest otwarcie ukrytego formularza startowego z włączonym Timerem, w którym to w pewnych odstępach czasu (patrz. właściwość Form.TimerInterval), będzie sprawdzała, czy nie jest otwarta druga instancja bazy (druga instancja MS Access)

Oczywistym rozwiązaniem powinno być wykorzystanie systemowych mechanizmów służących do synchronizacji wątków, czyli algorytmów wzajemnego wykluczania (w skrócie mutex, z ang. mutual exclusion) Jak wykorzystać mutex w celu uniemożliwienia otwarcia drugiej instancji bazy danych MS Access opisałem w artykule • Funkcje API - Mutex, jedna instancja bazy MS Access •