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