Access Close Button

[ABCRich]

I know how to disable the close button on forms, but I am do not know how to disable the close button for the entire database. I am running a shared database on a server in multiple locations using terminal services. We have terminal services set to start the DB on login and to close the terminal server session on close. Unfortunately, no matter how many times we tell our users not to use the "little x" in the top right corner, they "accidentally" do. This is causing problems. Does anyone know how to prevent the close button for the actual access program, not on a form. Thanks!

 

[Databaseguy]

A quick workaround is to have a modal form load up at start up. Have it munimize on open, and put this code in the on_unload event:

Dim msg
Dim resp
Dim Sty
msg = "Quit ?"
Sty = vbYesNo
resp = MsgBox(msg, Sty)
If resp = vbYes Then
  Cancel = False
Else
  Cancel = True
End If

Tyrone Lumley
augerinn@gte.net

http://server47.hypermart.net/databaseguy

 

[nickjar2]

Here is some code that will disable the code for the entire db.

create a new module and paste this in:

Function InitApplication()
Dim c As closeCommand
Set c = New closeCommand

'Disable Close menu.
c.Enabled = False

End Function

Create a new CLASS module and paste this in:

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

Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long

Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As _
Long, lpMenuItemInfo As MENUITEMINFO) As Long

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&

Public Property Get Enabled() As Boolean
Dim hWnd As Long
Dim hMenu As Long
Dim result As Long
Dim MI As MENUITEMINFO

MI.cbSize = Len(MI)
MI.dwTypeData = String(80, 0)
MI.cch = Len(MI.dwTypeData)
MI.fMask = MF_GRAYED
MI.wID = SC_CLOSE
hWnd = Application.hWndAccessApp
hMenu = GetSystemMenu(hWnd, 0)
result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
Enabled = (MI.fState And MF_GRAYED) = 0
End Property

Public Property Let Enabled(boolClose As Boolean)
Dim hWnd As Long
Dim wFlags As Long
Dim hMenu As Long
Dim result As Long

hWnd = Application.hWndAccessApp
hMenu = GetSystemMenu(hWnd, 0)
If Not boolClose Then
wFlags = MF_BYCOMMAND Or MF_GRAYED
Else
wFlags = MF_BYCOMMAND And Not MF_GRAYED
End If
result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Property


Open the module with the function InitApplication() and run it. This should disable the 'X' in the top right of Access.

It works for me,

Cheers,

Nick