Wer in seinem Programm das Windows API nutzt hat es schwer mit der Fehlerbehandlung, denn das VBA Error-Objekt bekommt davon (fast) nichts mit: tritt in einer aufgerufenen DLL Funktion ein Fehler auf, so wird lediglich die Eigenschaft Err.LastDllError beschrieben; diese löst aber in einer VB-Funktion keinen Fehler aus. Wir müssen uns also nach einem API-Aufruf selbst darum kümmern, wenn die Fehleranalyse für uns wichtig ist.

Damit wir nicht das Rad jedesmal neu erfinden müssen schreiben wir uns zu diesem Zweck eine eigene Fehlerbehandlungsroutine, die über die Err.Raise Funktion alle erforderlichen Informationen auf das VBA Error-Objekt umleiten kann. Die API Fehlernummer und Beschreibung speichern wir in separaten Variablen, so können wir die Werte, auch ohne einen VBA-Error auszulösen, verarbeiten (z.B. zum Schreiben in eine Logdatei). Die Fehlernummer der Error-Objekts, also Err.Number, setzten wir immer auf vbCustomError. Dieser Wert liegt außerhalb der VBA Fehlermeldungen und verhindert so Überschneidungen; die tatsächliche Meldungsnummer sichern wir in apiErrorNumber, die Beschreibung in apiErrorDescription.

Kommen wir nun zur Funktion "getAPIError", die wir unmittelbar nach dem API-Aufruf aufrufen. Als Parameter source übergeben wir den Funktionsnamen, der den Fehler ausgelöst hat als String; das optionale flRaise Flag bestimmt, ob ein VBA-Error ausgelöst werden soll, oder nicht:

Private Declare Function FormatMessageA Lib "kernel32" (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

Private Const LANG_NEUTRAL = &H0
Private Const FORMAT_MESSAGE_IGNORE_INSERTS = &H200
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

Public Const vbCustomError = &H80040200 ' vbObjectError + 512 is free for own use
Public apiErrorDescription As String    ' error description of API /DLL error
Public apiErrorNumber As Long           ' error number of API /DLL error


Public Function getAPIError(ByVal Source As String, _
                            Optional ByVal flRaise As Boolean) As Boolean
  Dim flags As Long, ret As Long
  Dim msg As String
 
  apiErrorNumber = Err.LastDllError         ' store the last DLL error immediately
  If apiErrorNumber Then                    ' if we have an error
    msg = String(256, 0)                    ' try to get the description text
    flags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS
    ret = FormatMessageA(flags, 0&, apiErrorNumber, LANG_NEUTRAL, msg, Len(msg), 0&)
    If ret Then                             ' if we have a message
      apiErrorDescription = Left$(msg, ret) ' store it in a public variable
    Else
      apiErrorDescription = "Unknown API error no. " & apiErrorNumber & " on " & Source
    End If
    getAPIError = True
    If flRaise Then                         ' do we want to raise an error?
      ' vbCustomError indicates an API ErrorMessage, to show the "REAL"
      ' error number in a MsgBox use apiErrorNumber instead of Err.Number
      Err.Raise vbCustomError, Source, apiErrorDescription
    End If
  Else
    apiErrorDescription = vbNullString      ' clear up the description
  End If
End Function

Beachtenswert:

• Bedenken Sie, dass die Variable Err.LastDllError bei jedem API-Aufruf ihren Wert aktualisiert! Ein Aufruf nach FormatMessageA wäre also sinnlos, da dann bereits der Rückgabewert dieser Funktion darin enthalten ist.
• Es gibt API-Funktionen, die trotz erfolgreichem Abschluss einen Wert ungleich Null in Err.LastDllError schreiben, hier hilft nur ausprobieren.

Nun noch ein Funktionsbeispiel zum Umbenennen von Dateien mit Unicodeunterstützung und API Fehlerauswertung.

Private Declare Function MoveFileExW Lib "kernel32" (ByVal lpExistingFileName As Long, _
                ByVal lpNewFileName As Long, ByVal dwFlags As Long) As Long
Private Const MOVEFILE_WRITE_THROUGH = 8

Public Function NameAs(ByVal src As String, ByVal dst, _
                       Optional ByVal useVBAErr As Boolean = True) As Boolean
  NameAs = MoveFileExW(StrPtr(src), StrPtr(dst), MOVEFILE_WRITE_THROUGH)
  getAPIError "NameAs", useVBAErr
End Function

Aufruf Beispiel mit VBA Error Auslösung:

NameAs "C:\TestFile.txt", "C:\Тестовый файл.txt", True

Autor: ralf schlegel
Stand: 12/2012

Nach oben

Wenn Sie im Quellcode einem Objekt den Focus zuweisen wollen, so geht dies in der Regel mit Object.SetFocus. Leider führt diese Methode aber zu einem Laufzeitfehler (Nr. 5: Ungütliger Prozeduraufruf oder ungültiges Argument), wenn das gewünschte Objekt nicht sichbar ist. Das ist nicht nur bei Object.Visible = False der Fall, sondern auch dann, wenn Sie den Focus in der Load-Anweisung einer Form explizit setzen wollen.

Abhilfe schafft hier die API-Funktion SetFocus, der lediglich das Handle des Objekts übergeben wird. Damit die SetFocus Funktion vom Namen her nicht mit der SetFocus-Methode von Objekten kollidiert, geben wir Ihr über einen Alias den Namen apiSetFocus und schreiben die Deklaration in ein Modul:

Public Declare Function apiSetFocus Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long

Um nun einem ListView-Object den Focus zu geben schreiben wir anstelle von

ListView1.SetFocus

die neue Funktion

apiSetFocus ListView1.hWnd

Nach oben

Passend zum Tipp Nummer 2 hier die API Deklaration zum ermitteln des aktiven Objekts (Controls) innerhalb der aktiven Form. Zurückgegeben wird das Handle des gefundenen Controls, mit dem Sie dann (sofern <> 0) weiter arbeiten können:

Public Declare Function GetFocus Lib "user32" As Long

Nach oben

Einen Klang erzeugen, wie die Messagebox (MsgBox) z.B. nach einer längeren Operation in Ihrem Programm können Sie auf folgende Weise:

Public Declare Function MessageBeep Lib "user32" (ByVal wType As BeepType) As Long

Public Enum BeepType
  MB_ICONASTERISK = &H40
  MB_ICONEXCLAMATION = &H30
  MB_ICONQUESTION = &H20
  MB_ICONERROR = &H10
  MB_OK = &H0
  MB_SPEEKER = -1
End Enum

So läßt sich der User nett aufwecken!
Fügen Sie den Code in ein beliebiges Modul ein.
"MB_SPEEKER" gibt den Ton über den PC-Lautsprecher aus, wenn keine Soundkarte vorhanden ist (gibt es soetwas heute noch?).

Nach oben

Zahlreiche API-Funktionen benötigen als Übergabeparameter ein Fenster Handle, so zum Beispiel die "SHFileOperation", oder "OpenClipboard". Leider steht ein solches Handle nicht immer unmittelbar zur Verfügung, erst recht nicht, wenn wir unseren Code in VBA (Excel oder Word) implementieren. An solchen stellen bietet sich die "GetForegroundWindow" API an, die immer ein gültiges Handle findet - im Zweifelsfall den Desktop selbst! Für die OpenClipborad Funktion würde dies folgendermaßen aussehen:

Public Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

If OpenClipboard(GetForegroundWindow) Then
  ' mach irgendwas
  CloseClipboard
End If

Nach oben

Was ist eigentlich der Unterschied zwischen GetActiveWindow() und GetForegroundWindow()?:

Public Declare Function GetActiveWindow Lib "user32" () As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long

Auf den ersten Blick: keiner! - und auf den zweiten?

Nehmen wir an Sie verwenden die API Funktion MessageBoxW anstelle der VBA internen Funktion MsgBox, weil ihre Textausgabe z.B. Unicode unterstützen soll. Die Funktion MessageBoxW benötigt nun aber ein Fensterhandle (hWnd), das uns nicht immer zur Verfügung steht. Viele Programmierer greifen dann auf GetForegroundWindow zurück, was erst einmal nicht falsch ist, aber vielleicht gar nicht gewollt: denn GetForeGroundWindow legt die MessageBox systemweit in den Vordergrund, während GetActiveWindow sich nur auf den aktuellen Prozess (also Ihre Anwendung) bezieht. Man könnte auch sagen: GetForegroundWindow entspricht dem MsgBox Flag vbSystemModal und blockiert damit u.U. auch andere Anwendungen.
Überlegen Sie sich also genau, wie Ihre MessageBox in Erscheinung treten soll! Hier nun noch das komplette Beispiel:

Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, _
        ByVal lpText As Long, ByVal lpCaption As Long, ByVal lStyle As VbMsgBoxStyle) As VbMsgBoxResult

Public Function MessageBox(ByVal lpText As String, _
       ByVal lpCaption As String, ByVal mbStyle As VbMsgBoxStyle) As VbMsgBoxResult
  Dim hWnd As Long

  If (mbStyle And vbSystemModal) Then
    hWnd = GetForegroundWindow  ' get the active window handle of the system
  Else
    hWnd = GetActiveWindow      ' get the active window handle of your application
  End If
  MessageBox = MessageBoxW(hWnd, StrPtr(lpText), StrPtr(lpCaption), mbStyle)
End Function

Autor: ralf schlegel
Stand: 12/2012

Nach oben