VBOffice

GetSelectNamesDialog Pre-fill Search Box

Do you want to add some convenience for your users? See how to fill-in the search box of the address book by code.

Last modified: 2018/11/20 | Accessed: 34.246  | #159
◀ Previous sample Next sample ▶

Content

Reporter Reporter
VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month.

Part 1

You can call the dialog to find names in the address book by VBA. Outlook uses this dialog, for instance, when you click the To button on an email in order to select the recipient. The GetSelectNamesDialog function returns a SelectNamesDialog object, which allows you to control the behavior of the dialog. For instance, you can determine the address book to begin the search with, or set whether multiple recipients are allowed. However, Outlook doesn't support to pre-fill the search box with a name.

By using the Win32 API we can get a handle on that textbox and send a string to it. In order to get the handle, the dialog must be displayed first. Because Outlook displays the dialog modal, that is following code won't be executed before the dialog is closed, we need to use a timer to get an event after the dialog is displayed.

Add a new module via Insert/Module and paste the entire following code. The first part shows the declarations of the API functions.


tip  How to add macros to Outlook
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
Category-Manager Category-Manager
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP.

Part 2

DisplayDialog is the procedure you'll call from your code. Pass to it the name that you want to pre-fill the search box with.

In order to get the handle on the dialog it is necessary to know its caption. A placeholder (*) is allowed. This sample uses the caption 'Select Names: *'. If this sample doesn't work for you, then ensure you're using the caption here that is used in your version of Outlook.

The procedure DisplayDialog starts the timer with a delay of 500ms, then it displays the modal dialog. Now it takes half a second until the timer calls the TimerProc procedure. In that procedure the timer will be killed immediately as we don't need another signal. Then it starts the search for the window in order to pre-fill it with the name you want to seach in the address book. If you get the 'window not found' prompt, as mentioned, then most likely you need to change the caption from 'Select Names: *' to the one that is used in your version of Outlook.

Public Sub DisplayDialog(FindThisName As String)
  On Error GoTo ERR_HANDLER
  Dim Dlg As Outlook.SelectNamesDialog
  
  m_DialogCaption = "Select Names: *"
  
  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 "window not found"
  End If
End Sub
OLKeeper OLKeeper
OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.

Part 3

Here come the calls of the API functions to complete the sample.

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
SAM SAM
Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.
email  Send a message