• 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 .