INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

VBA Visual Basic for Applications (Microsoft) FAQ

Excel How To

Prevent Excel From Closing by AccessGuruCarl
Posted: 19 Oct 04

This code will will prevent Excel from closing or give the user the option to close excel and log-off the computer.

Keywords: Prevent Excel from closing, Close Windows from Excel.

Paste this code into a new excel Module.

CODE

Option Explicit
'Set Types
Public Type LUID
   LowPart As Long
   HighPart As Long
End Type
Public Type LUID_AND_ATTRIBUTES
        pLuid As LUID
        Attributes As Long
End Type
Public Type TOKEN_PRIVILEGES
    PrivilegeCount As Long
    Privileges(1) As LUID_AND_ATTRIBUTES
End Type
' Declare API functions.
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, _
   ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" _
   (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, _
   ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength _
   As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

' Set Set ShutDown Privilege Constants
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2

Public Sub SetShutDownPrivilege()
Dim Phndl As Long, Thndl As Long
Dim MyLUID As LUID
Dim MyPriv As TOKEN_PRIVILEGES, MyNewPriv As TOKEN_PRIVILEGES
Phndl = GetCurrentProcess()
OpenProcessToken Phndl, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, Thndl
LookupPrivilegeValue "", "SeShutdownPrivilege", MyLUID
MyPriv.PrivilegeCount = 1
MyPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
MyPriv.Privileges(0).pLuid = MyLUID
' Now to set shutdown privilege for my app
AdjustTokenPrivileges Thndl, False, MyPriv, 4 + (12 * MyPriv.PrivilegeCount), MyNewPriv, 4 + (12 * MyNewPriv.PrivilegeCount)
End Sub

Paste this code into the ThisWorkbook VBE

CODE

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim Msg, Style, Title, Response
Dim MyFlag As Long, Ret As String
'Set ShutDown Constants
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4

' Define message.
Msg = "Do you want to continue ?" _
    & vbCr & vbCr & "You are about to exit the Inventory program." _
    & vbCr & vbCr & "You will need to Reboot Computer" _
    & vbCr & "to restore the Inventory!"
Style = vbYesNoCancel + vbCritical + vbDefaultButton3    ' Define buttons.
Title = "Exiting Inventory"    ' Define title.
' Display message.
Response = MsgBox(Msg, Style, Title)
'Test the variable Response
Select Case Response
  Case vbYes
    'Save the file, Force Windows Closed
    Me.Save
 '   Call Exit_Windows
    Ret = InputBox("Enter Password", "Password Required")
        If Ret = "xyz" Then
        Ret = InputBox("Exit Excel or Logoff User" _
        & vbCr & " Enter: E or L", "What Action")
        Else
        MsgBox "Invalid Password", vbCritical, "Wrong Password"
        Cancel = False
        Exit Sub
        End If
    If Ret = "E" Or Ret = "e" Then
    'Do nothing -
    Else
    If Ret = "L" Or Ret = "l" Then
    SetShutDownPrivilege 'Set the shutdown privilege - else reboot will fail
' Always execute a force shutdown if a shutdown is required
    MyFlag = EWX_LOGOFF  'LogOff
' Grab the shutdown privilege - else reboot will fail
    SetShutDownPrivilege
' Do the required action
    Call ExitWindowsEx(MyFlag, 0)
    End If
    End If
  Case vbNo
    Worksheets(1).Activate
    Cancel = True
  Case vbCancel
    Cancel = True
  Case Else
  'Do Nothing
End Select

End Sub

Private Sub Workbook_Open()
On Error Resume Next
    'Activate the 1st worksheet using the workbooks worksheet index
    Worksheets(1).Activate
    'Or If you want to use the actual worksheet name
    'Worksheets("Sheet1").Activate
End Sub

That's it. Modify the close event as needed.
I'm currently logging the user off, so that an administrator can log on, via PC Anywhere and update the excel file.

Working like a charm....

Back to VBA Visual Basic for Applications (Microsoft) FAQ Index
Back to VBA Visual Basic for Applications (Microsoft) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close