Create msgbox to confirm before Outlook closes

zoso · Nov 28, 2005

Hi there!

I have the following code:

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 · Nov 29, 2005

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 · Nov 29, 2005

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 · Nov 29, 2005

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 ...

Option Explicit
Option Private Module

Private Const cntMENUITEMS As Long = 9
Private Const MF_BYPOS As Long = &H400

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
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As _
 String, ByVal lpWindowName As String) As Long

Public Sub RestoreSystemMenu()
 Dim lHandle As Long, i As Long
 lHandle = FindWindowA(vbNullString, Application.ActiveExplorer.Caption)
 For i = 1 To cntMENUITEMS
 GetSystemMenu lHandle, True
 Next i
End Sub

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



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

NateO · Nov 29, 2005

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.,

Code:

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 · Nov 29, 2005

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

zoso · Nov 30, 2005

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 · Nov 30, 2005

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 · Nov 30, 2005

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 · Nov 30, 2005

Hello again,

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

:wink:

zoso · Nov 30, 2005

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

Here's the working solution: (module)

Code:

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"

Code:

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.

Create msgbox to confirm before Outlook closes

zoso

Well-known Member

Zack Barresse

MrExcel MVP

Some videos you may like

Excel Facts

zoso

Well-known Member

Zack Barresse

MrExcel MVP

NateO

Legend

Zack Barresse

MrExcel MVP

zoso

Well-known Member

NateO

Legend

zoso

Well-known Member

NateO

Legend

zoso

Well-known Member

Similar threads

Watch MrExcel Video

Forum statistics

Share this page

Create msgbox to confirm before Outlook closes

Well-known Member

MrExcel MVP

Some videos you may like

Excel Facts

Well-known Member

MrExcel MVP

Legend

MrExcel MVP

Well-known Member

Legend

Well-known Member

Legend

Well-known Member

Similar threads

Watch MrExcel Video

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock