VBOffice

Place the Cursor Into a Message

Via the Outlook object model you cannot set the focus to a specific control. This sample demonstrates how to do it with the Win32 API.

Last modified: 2006/01/30 | Accessed: 28.840  | #20
◀ Previous sample Next sample ▶
SAM SAM
Determine the "identity" of your emails. Set with SAM the sender, signature and folder for sent items with the help of rules.

With the Win32 API you can set the focus or the cursor to any control that supports it. You just need to know the structure of the windows. That structure can be examined with a tool like 'Spy++'. In this sample for Outlook 2000 and 2003 we set the cursor into the notes field of an emailö

Add a new module via Insert/Module, and paste the code there. Additionally, you need this macro: Get Outlook Version


tip  How to add macros to Outlook
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" _
  (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindow Lib "USER32" (ByVal hwnd _
  As Long, ByVal wCmd As Long) As Long
Private Declare Function SetForegroundWindow Lib "USER32" _
  (ByVal hwnd As Long) As Long

Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2

Public Function SetFocusOnBody(sInspectorCaption As String) As Boolean
  Dim lHwnd As Long

  lHwnd = GetInspectorHandle(sInspectorCaption)
  lHwnd = GetBodyHandle(lHwnd)
  If lHwnd Then
    SetFocusOnBody = CBool(SetForegroundWindow(lHwnd))
  End If
End Function

Private Function FindChildClassName(ByVal lHwnd As Long, _
  sFindName As String _
) As Long
  Dim lRes As Long

  lRes = GetWindow(lHwnd, GW_CHILD)
  If lRes Then
    Do
      If GetClassNameEx(lRes) = sFindName Then
        FindChildClassName = lRes
        Exit Function
      End If
      lRes = GetWindow(lRes, GW_HWNDNEXT)
    Loop While lRes <> 0
  End If
End Function

Private Function GetBodyHandle(ByVal lInspectorHwnd As Long) As Long
  Dim lRes As Long
  Dim lHnd As Long

  DetermineOutlookVersion Application

  Select Case GetOutlookVersion
  Case 9
    lRes = FindChildClassName(lInspectorHwnd, "AfxWnd")
    If lRes Then
      lRes = GetWindow(lRes, GW_CHILD)
      If lRes Then
        lRes = FindChildClassName(lRes, "AfxWnd")
        If lRes Then
          lRes = GetWindow(lRes, GW_CHILD)
          If lRes Then
            ' plain/text: ClassName="RichEdit20A", html: ClassName="Internet Explorer_Server"
            GetBodyHandle = GetWindow(lRes, GW_CHILD)
          End If
        End If
      End If
    End If

  Case 11
    lRes = FindChildClassName(lInspectorHwnd, "AfxWndW")
    If lRes Then
      lRes = GetWindow(lRes, GW_CHILD)
      If lRes Then
        lRes = FindChildClassName(lRes, "AfxWndA")
        If lRes Then
          lRes = FindChildClassName(lRes, "AfxWndW")
          If lRes Then
            ' plain
            lHnd = FindChildClassName(lRes, "RichEdit20W")
            If lHnd = 0 Then
              ' hmtl
              lHnd = FindChildClassName(lRes, "Internet Explorer_Server")
            End If
            GetBodyHandle = lHnd
          End If
        End If
      End If
    End If
  End Select
End Function

Private Function GetClassNameEx(ByVal lHwnd As Long) As String
  Dim lRes As Long
  Dim sBuffer As String * 256
  lRes = GetClassName(lHwnd, sBuffer, 256)
  If lRes <> 0 Then
    GetClassNameEx = left$(sBuffer, lRes)
  End If
End Function

Private Function GetInspectorHandle(ByVal sCaption As String) As Long
  GetInspectorHandle = FindWindow("rctrl_renwnd32", sCaption)
End Function
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.
email  Send a message