Adressbuch: Name suchen

Teil 1

Sie können mit VBA den Dialog aufrufen, um im Outlook-Adressbuch nach Namen zu suchen. Dieser Dialog wird z.B. verwendet, wenn Sie in der Email auf die 'An'-Schaltfläche klicken, um einen Empfänger für die Email auszuwählen. Die Funktion GetSelectNamesDialog gibt ein SelectNamesDialog-Objekt zurück und über das Objekt können Sie das Verhalten des Dialogs steuern. So können Sie z.B. festlegen, mit welchem Adressbuch die Suche beginnen soll, ob mehrere Adressen ausgewählt werden dürfen und so weiter. Es gibt aber keinen Weg, das Suchfeld bereits mit einem Suchbegriff vorzubelegen.

Mithilfe der Win32 API können Sie das Textfeld ermitteln und einen Text hineinschreiben. Das geht aber erst, wenn der Dialog bereits angezeigt wird. Da Outlook den Dialog modal anzeigt, nachfolgender Code also erst ausgeführt wird, nachdem der Dialog wieder geschlossen wurde, ist ein Umweg über einen Timer nötig.

Erstellen Sie über Einfügen/Modul ein neues Modul und fügen Sie den kompletten nachfolgenden Code ein. Im ersten Teil haben wir die Deklarationen der API-Funktionen.

  So fügen Sie Makros in Outlook ein

Private Declare Function GetDesktopWindowA Lib "user32" Alias _
  "GetDesktopWindow" () As Long
Private Declare Function GetWindow Lib "user32" _
  (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowTextA Lib "user32" _
  (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassNameA Lib "user32" _
  (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessageByStringA Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, ByVal lParam$) As Long
Private Declare Function SetTimer Lib "user32.dll" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private hEvent As Long

Const WM_TIMER = &H113
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_SETTEXT = &HC

Private m_FindThisName As String
Private m_DialogCaption As String

Teil 2

Im zweiten und dritten Teil folgen die Funktionen. DisplayDialog ist die Prozedur, die Sie von Ihrem Code aus aufrufen. Übergeben Sie der Funktion den zu suchenden Begriff.

Damit die API-Funktionen den Dialog finden können, muss die Titelleiste des Dialogs bekannt sein. Ein Platzhalter (*) am Ende ist erlaubt. Das Beispiel verwendet als Titelleiste 'Namen auswählen: *'. Wenn das Beispiel bei Ihnen nicht funktioniert, stellen Sie sicher, hier der richtige Wert eingetragen ist, so wie der in Ihrer Outlook-Version verwendet wird.

Die Prozedur DisplayDialog startet den Timer mit einer Verzögerung von 500ms und zeigt direkt danach den Dialog an. Nun dauert es eine halbe Sekunde, bis der Timer die TimerProc-Funktion aufruft. In der Funktion wird der Timer sofort wieder abgeschaltet, damit keine weiteren Aufrufe erfolgen. Dann beginnt die Suche des Fensters, um dort den zu suchenden Namen einzutragen. Wenn Sie die Meldung 'Fenster nicht gefunden' erhalten, dann müssen Sie - wie gesagt - wahrscheinlich den Begriff der Titelleiste anpassen.

Public Sub DisplayDialog(FindThisName As String)
  On Error GoTo ERR_HANDLER
  Dim Dlg As Outlook.SelectNamesDialog
  
  m_DialogCaption = "Namen auswählen: *"
  
  m_FindThisName = FindThisName
  
  If hEvent = 0 Then
    Set Dlg = Application.Session.GetSelectNamesDialog
    hEvent = SetTimer(0&, 0&, 500, AddressOf TimerProc)
    Dlg.Display
  End If
  
  Exit Sub
ERR_HANDLER:
  DisableTimer
End Sub

Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
  ByVal wParam As Long, ByVal lParam As Long _
)
  If uMsg = WM_TIMER Then
    DisableTimer
    PrefillSelectNames
  End If
End Sub

Private Sub DisableTimer()
  KillTimer 0&, hEvent
  hEvent = 0
End Sub

Private Sub PrefillSelectNames()
  Dim hnd As Long
  Dim OK As Boolean
  
  hnd = GetDesktopWindowA
  hnd = FindChildWindowText(hnd, m_DialogCaption)
  
  If hnd Then
    hnd = FindChildClassName(hnd, "RichEdit20W")
    If hnd Then
      SetText hnd, m_FindThisName
      OK = True
    End If
  End If
  If OK = False Then
    MsgBox "Fenster nicht gefunden"
  End If
End Sub

Teil 3

Hier folgen zum Schluß noch die Aufrufe der API-Funktionen. Damit ist der Code dann komplett.

Private Function FindChildWindowText(ByVal lHwnd As Long, sFind As String) As Long
  Dim lRes As Long
  Dim sFindLC As String

  lRes = GetWindow(lHwnd, GW_CHILD)
  If lRes Then
    sFindLC = LCase$(sFind)
    Do
      If LCase$(GetWindowText(lRes)) Like sFindLC Then
        FindChildWindowText = lRes
        Exit Function
      End If
      lRes = GetWindow(lRes, GW_HWNDNEXT)
    Loop While lRes <> 0
  End If
End Function

Private Function GetWindowText(ByVal lHwnd As Long) As String
  Const STR_SIZE As Long = 256
  Dim sBuffer As String * STR_SIZE
  Dim lSize As Long

  sBuffer = String$(STR_SIZE, vbNullChar)
  lSize = GetWindowTextA(lHwnd, sBuffer, STR_SIZE)
  If lSize > 0 Then
    GetWindowText = Left$(sBuffer, lSize)
  End If
End Function

Private Function FindChildClassName(ByVal lHwnd As Long, ByRef sFind As String) As Long
  Dim lRes As Long
  Dim sFindLC As String

  lRes = GetWindow(lHwnd, GW_CHILD)
  If lRes Then
    sFindLC = LCase$(sFind)
    Do
      If LCase$(GetClassName(lRes)) = sFindLC Then
        FindChildClassName = lRes
        Exit Function
      End If
      lRes = GetWindow(lRes, GW_HWNDNEXT)
    Loop While lRes <> 0
  End If
End Function

Private Function GetClassName(ByVal lHwnd As Long) As String
  Const CN_SIZE As Long = 256
  Dim sBuffer As String * CN_SIZE
  Dim lSize As Long

  lSize = GetClassNameA(lHwnd, sBuffer, CN_SIZE)
  If lSize > 0 Then
    GetClassName = Left$(sBuffer, lSize)
  End If
End Function

Private Function SetText(ByVal hwnd As Long, ByVal sText As String)
  SetText = SendMessageByStringA(hwnd, WM_SETTEXT, 0, sText)
End Function