API-Fehler richtig auswerten

Die meisten API-Funktion liefern nach getaner Arbeit einen Status-Code zurück, der besagt, ob die Ausführung korrekt verlaufen ist oder nicht. Ist ein Fehler aufgetreten, so kann man den richtigen Fehlercode NUR über die LastDLLError-Eigenschaft des Err-Objekts abfragen! Wie in einem MSDN-Artikel beschrieben ist, sollte man als VB-Programmierer niemals auf den Gedanken kommen von der API-Funktion GetLastError Gebrauch zu machen, denn auch die VB-Runtime macht von der API regen Gebrauch und es ist nicht gesagt, dass der letzte Fehler der des eigenen API-Aufrufs war.

Wenn denn dann ein API-Fehler aufgetreten ist und die korrekte Fehlernummer über LastDLLError vorliegt, so wäre eine aussagekräftige Fehlerbeschreibung nicht schlecht. Da API-Fehler nichts mit VB-Fehlern zu tun haben, wird die Description-Eigenschaft des Err-Objekt leider leer sein. Zuständig für die Lieferung des Klartextes ist wiederum eine API-Funktion: FormatMessage.

Beispiel:

Deklarationen

Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200&
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF&
Private Const LANG_USER_DEFAULT As Long = &H400&

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
   ByVal dwFlags As Long, _
   ByRef lpSource As Any, _
   ByVal dwMessageId As Long, _
   ByVal dwLanguageId As Long, _
   ByVal lpBuffer As String, _
   ByVal nSize As Long, _
   ByRef Arguments As Long) As Long

Prozedur

Public Function GetAPIErrorDescription( _
   ByVal lngLastDllError As Long) As String

   Dim strBuffer As String
   Dim lngLen As Long
   Dim lngFlags As Long

   strBuffer = Space$(1024)
   lngFlags = FORMAT_MESSAGE_FROM_SYSTEM Or _
      FORMAT_MESSAGE_MAX_WIDTH_MASK Or _
      FORMAT_MESSAGE_IGNORE_INSERTS

   lngLen = FormatMessage(lngFlags, ByVal 0&, lngLastDllError, _
      LANG_USER_DEFAULT, strBuffer, Len(strBuffer), 0)

   If lngLen > 0 Then
      GetAPIErrorDescription = Left$(strBuffer, lngLen)
   End If

End Function

Aufruf

Public Function Test()

   Dim lngRetVal As Long

   lngRetVal = <Aufruf der gewünschten API-Funktion>

   If lngRetVal <> 0 And Err.LastDllError <> 0 Then
      Err.Raise vbObjectError + Err.LastDllError, , _
         GetAPIErrorDescription(Err.LastDllError)
   End If

End Function