How do I make a Userform/prompt on top of a send window from senditem event

J

jdc

I've scanned newsgroups but can't seem to find answer to this.

I'm trying to trap the outlook application senditem in OL2003 using VB
6.3 to prompt for additional details depending on recipient.

both the prompt and the userform only appear on top of the application
window not the actual sending window. Why? Help Please?

My basic Code so far:-

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As
Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If

als_lookup.Show 1
End Sub
 
M

Michael Bauer

Am 14 Oct 2005 07:53:49 -0700 schrieb (e-mail address removed):

Forcing a window to displaying on top is a lot of stuff in VBA because the
UserForm doesn´t provide you with its window handle.

I´m not familiar with UserForms. On the first look I can´t find an event
that fires after a modal dialog is being displayed. That is you´d need a
hack to call code after the Show 1 line.

Anyway, the same hack is necessary for a MsgBox and can be achieved by a
timer. Please google for "modTimer.bas", I have posted a sample several
times. Additionally copy the code below into "ThisOutlookSession".

Call the timer with a delay of maybe 100ms just before calling the MsgBox or
the UserForm.

In the ThisOutlookSession.Timer method, called back from the
modTimer.TimerProc method, you need then to:

1. Stop the Timer!
2. Call SetWindowPos* with the Caption of the Form/MsgBox:

Dim str$:str=UserForm1.Caption ' (or the MsgBox caption)
SetWindowTopMostActivateNoSize FindChildWindowText( _
GetDesktopWindowA, str)


<ThisOutlookSession>
Private Declare Function SetWindowPosA Lib "USER32" Alias "SetWindowPos"
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y
As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
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

Const HWND_TOPMOST As Long = -1
Const SWP_SHOWWINDOW As Long = &H40
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const GW_HWNDNEXT = 2
Const GW_CHILD = 5

Private Function SetWindowTopMostActivateNoSize(ByVal hwnd As Long) As Long
SetWindowTopMostActivateNoSize = _
SetWindowPosA(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or
SWP_NOMOVE Or SWP_NOSIZE)
End Function

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)) = 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
</ThisOutlookSession>
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top