Create msgbox to confirm before Outlook closes

[zoso]

Hi there!

I have the following code:

Private Sub Application_Quit()
    Dim Response As Integer
    Dim Title As String
    Dim Message As String

   Title = "Confirm"
   Message = "Do you really want to quit Outlook?"
   Response = MsgBox(Message, vbYesNo, Title)
   If Response = vbNo Then
       ???????????????
   End If
End Sub

What I'm after is some code in place of the ???????? so that Outlook remains open.

Hope you can help - and thanks!

 

[Zack Barresse]

Btw, leaving the DisableExit code the way it is, this will prompt you for a password when the application opens as well. Of course this can be surpressed and it can be done automatically if you'd like.

 

[zoso]

Zack - that is REALLY useful, thanks ever such a lot for all your help there!

Paul/ZoSo

P.S. The 'X' closing problem seems to be the holy grail - no-one out there has a solution for it - hope you can prove 'em wrong Zack!!!

 

[Zack Barresse]

WOOOHOOOO!!! I DID IT!!!

Holy crap, didn't think I could do it, but I did. Here is the code, put in a Standard Module ...


<font face=Tahoma New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>
<SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Module</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> cntMENUITEMS <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 9
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Const</SPAN> MF_BYPOS <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = &H400

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> GetSystemMenu <SPAN style="color:#00007F">Lib</SPAN> "user32" (<SPAN style="color:#00007F">ByVal</SPAN> hWnd <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, _
    <SPAN style="color:#00007F">ByVal</SPAN> bRevert <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> DeleteMenu <SPAN style="color:#00007F">Lib</SPAN> "user32" (<SPAN style="color:#00007F">ByVal</SPAN> hMenu <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ByVal _
    nPosition <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> wFlags <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Declare</SPAN> <SPAN style="color:#00007F">Function</SPAN> FindWindowA <SPAN style="color:#00007F">Lib</SPAN> "user32" (<SPAN style="color:#00007F">ByVal</SPAN> lpClassName As _
    <SPAN style="color:#00007F">String</SPAN>, ByVal lpWindowName <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>

<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> RestoreSystemMenu()
    <SPAN style="color:#00007F">Dim</SPAN> lHandle <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    lHandle = FindWindowA(vbNullString, Application.ActiveExplorer.Caption)
    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> cntMENUITEMS
        GetSystemMenu lHandle, <SPAN style="color:#00007F">True</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> i
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Sub</SPAN> DeleteSystemMenu()
    <SPAN style="color:#00007F">Dim</SPAN> lHandle <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN>
    lHandle = FindWindowA(vbNullString, Application.ActiveExplorer.Caption)
    <SPAN style="color:#00007F">If</SPAN> lHandle <> 0 <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> cntMENUITEMS
            DeleteMenu GetSystemMenu(lHandle, <SPAN style="color:#00007F">False</SPAN>), 0, MF_BYPOS
        <SPAN style="color:#00007F">Next</SPAN> i
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

</FONT>


Works for me very well in OL 2003. Please test and get back to me.

 

[NateO]

Sorry, realized you were asking a different question following my response. Yeah, there's no cancel hook there, eh?

In any case does disabling the X button help? E.g.,

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal bRevert As Long) As Long

Private Declare Function DeleteMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long

Sub killButts()
Call DeleteMenu(GetSystemMenu(FindWindow("rctrl_renwnd32", _
    vbNullString), 0), 6, 1024)
End Sub

Sub restoreButts()
Call GetSystemMenu(FindWindow("rctrl_renwnd32", vbNullString), True)
End Sub

This is only good for Outlook as it uses Outlook's Class name.

For comments, see the following:
http://support.microsoft.com/kb/818361#6


Edited by Nate: Ah, there's the Caption Property, Zack. Was looking for that, I'll know to try my object browser next time...

 

[Zack Barresse]

Nate, don't look in your Object Browser, get OutlookSpy. Much easier way of browsing the Object Browser.

 

[zoso]

Hi Guys - thanks to both of you for your help but unfortunately neither make any difference when I click the 'x'.

Zack - FYI I'm also running Outlook 2003...

Thanks anyway!

 

[NateO]

Running killButts definitely disables the X button in the front-end of Outlook 2003, and should work in all versions.

Make sure you copy all of the API calls as well.

 

[zoso]

Hi Nate!

Yes, of course you're right, killbutts does disable the X button, although it seems that it needs to be run manually each time Outlooks runs

Is there any way that the code can be run automatically each time Outlook opens, or alternatively, permanently disabled?

Thanks again!

 

[NateO]

Hello again,

Add the procedures to Zack's Private Sub Application_Startup() procedure? :wink:

 

[zoso]

Zack/Nate - you did it, it works brilliantly, thanks ever such a lot!

Here's the working solution: (module)

Option Explicit

'This macro disables the close 'x' box
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Function GetSystemMenu Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal bRevert As Long) As Long

Private Declare Function DeleteMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long) As Long

Sub DisableExitButton()
Call DeleteMenu(GetSystemMenu(FindWindow("rctrl_renwnd32", _
    vbNullString), 0), 6, 1024)
End Sub

Sub RestoreExitButton()
Call GetSystemMenu(FindWindow("rctrl_renwnd32", vbNullString), True)
End Sub

And here's the code I put in "This Outlook Session"

Private Sub Application_Startup()

SendKeys ("% n")
'This line forces Outlook to start minimized
Call DisableExitButton
'This macro disables the close 'x' box
End Sub

Note the Sendkeys line - I put this in to make sure Outlook always starts minimized.