UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Closing Application And Beforeupdate On A Form, Access 2010    
 
   
jimbofoxman
post Nov 1 2019, 09:41 AM
Post#1



Posts: 395
Joined: 4-April 08



I am trying to combat people pressing X for the entire Application and leaving a stranded record. Basically we don't assign a contract number until a several items are filled out. I can't use a hidden form like many threads suggest, at least on this particular form. So I am trying to use BeforeUpdate. Then I ended up getting the can't save error, so I tried trapping Error 2169, but it still exits despite giving the option to exit or not (stay on record).

When someone clicks a button, whether it's a button for New, Delete, Print, Exit, Etc...........it runs a Private Function that does a bunch of checks/validations then sets blButtonOk = True or False. Everything works great until I started messing with the BeforeUpdate. Not including all the ButtonOk code, as it's quite long and required a flow chart originally to write it.

CODE
Option Compare Database
Option Explicit
Dim strPressed As String

Private Function ButtonOk(strType As String) 'As Boolean
On Error GoTo Err_Handler

    Dim EstResp As Integer, blButtonOk As Boolean, ContResp As Integer, DelResp As Integer, strCheck As String, ctlFocus As control, blCheck As Boolean, ContResp2 As Integer
    Dim DateResp As Integer, ExitResp As Integer, blEmailPrint As Boolean, strEmailPrint As String, maxID As Integer, UndoResp As Integer, DupeResp As Integer
    
    'Start off assuming everything is good
    blButtonOk = True       'Tells whether a button can be run
    blCheck = True          'Tells whether to run additional contract checks or not
    blEmailPrint = True     'Tells whether a contract can be printed or emailed
    strPressed = strType
.
.
.
            ElseIf strType = "Exit" Or strType = "Lookup" Or strType = "Search" Then
                ExitResp = MsgBox("This appears to be a new contract.  If you exit this form nothing will be saved.  Do you want to exit?", vbQuestion + vbYesNo + vbDefaultButton2, "Exit New Contract")
                If ExitResp = vbYes Then
                    Me.Undo
                    Me.Filter = ""
                    Me.FilterOn = False
                    blCheck = False
                    blButtonOk = True
                Else
                    Me.SearchForEst.SetFocus
                    blCheck = False
                    blButtonOk = False
                End If
.
.
.
    strPressed = ""
    
Exit_Handler:
    Exit Function
Err_Handler:
    Call DisplayError(Err, "ButtonOk")
    Resume Exit_Handler
End Function


Where I am having an issue is if the user is in the middle of a New Record. Per above, if they answer yes to wanting to exit it works fine because it does an Undo. If they want to stay it is still exiting using the code below. Which I am just messing with now trying to figure it all out. I tried trapping 2169, which it does but then it still exits despite saying I don't want to leave.

CODE
Private Sub Form_BeforeUpdate(Cancel As Integer)
'On Error GoTo Err_Handler

    If strPressed = "" Then
        If ButtonOk("Exit") Then
            MsgBox strPressed & "/ Ok to exit"
        Else
            MsgBox strPressed & "/ DO NOT EXIT"
            Cancel = True
        End If
    End If

    'UpdateEdit Me

'Exit_Handler:
'    Exit Sub
'Err_Handler:
'    Call DisplayError(Err, "EquipmentNotes_DblClick", Me.Form.NAME)
'    Resume Exit_Handler
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    Select Case DataErr
    Case 2169
        MsgBox "Error Supressed"
        Response = acDataErrContinue
    Case Else
        Response = acDataErrDisplay
    End Select
End Sub


So the message box saying "DO NOT EXIT" pops up, then the MsgBox "Error Suppressed" pops up, then it exits even though I said NO.

Is the Response = acDataErrContinue making it still allow it to exit? Basically I just want it to go back to the unfinished record.

Any thoughts? Hopefully it's not confusing
Go to the top of the page
 
GroverParkGeorge
post Nov 1 2019, 10:27 AM
Post#2


UA Admin
Posts: 36,206
Joined: 20-June 02
From: Newcastle, WA


When I want to prevent users from closing the Access application without going through an "authorized" exit command button, I have used the following.

It consists of a Class module and a line of code.

The Class module:

CODE
'---------------------------------------------------------------------------------------
' Module    : cls_AppFunctions
' Author    : blars1
' Date      : 05/30/2008
' Purpose   : For locking the app Close X button
'---------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, _
    ByVal bRevert As LongPtr) As LongPtr
#Else
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As LongPtr, _
    ByVal bRevert As LongPtr) As LongPtr
#End If

#If VBA7 Then
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As _
    LongPtr, ByVal wIDEnableItem As LongPtr, ByVal wEnable As LongPtr) As LongPtr
#Else
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
    LongPtr, ByVal wIDEnableItem As LongPtr, ByVal wEnable As LongPtr) As LongPtr
#End If
#If VBA7 Then
Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias _
    "GetMenuItemInfoA" (ByVal hMenu As LongPtr, ByVal un As LongPtr, ByVal b As _
    LongPtr, lpMenuItemInfo As MENUITEMINFO) As LongPtr
#Else
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
    "GetMenuItemInfoA" (ByVal hMenu As LongPtr, ByVal un As LongPtr, ByVal b As _
    LongPtr, lpMenuItemInfo As MENUITEMINFO) As LongPtr
#End If

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

Private Const MF_GRAYED As Long = &H1&
Private Const MF_BYCOMMAND As Long = &H0&
Private Const SC_CLOSE As Long = &HF060&

Public Property Get enabled() As Boolean
    Dim hWnd As LongPtr
    Dim hMenu As LongPtr
    Dim result As LongPtr
    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(ByVal boolClose As Boolean)
    Dim hWnd As LongPtr
    Dim wFlags As Long
    Dim hMenu As LongPtr
    Dim result As LongPtr

    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


The following function is called in the AutoExec macro.
It enables the class module to prevent closing the Access Application via the "X" or Close command.

CODE
Public Function InitApplication() As Boolean

    'disabled in development
    Dim cC As CloseCommand

    On Error GoTo ErrHandler

    Set cC = New CloseCommand
    
    InitApplication = False

    'Disable Close menu.
    cC.enabled = False
    InitApplication = True

Cleanup:

    On Error Resume Next

ExitProc:

    Exit Function

ErrHandler:

    MsgBox err & err.Description
    resume Cleanup

End Function


When you implement this, it completely disables the ability to close Access by clicking the "X" to exit. Users can then only close the application via whatever method you implement from a command button on a menu form.

You can do this with this line:

CODE
            Application.Quit


It's a drastic step, IMO, but it does prevent "accidental" exits.

--------------------
My Real Name Is George. Grover Park Consulting is where I did business for 20 years.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
jimbofoxman
post Nov 1 2019, 10:45 AM
Post#3



Posts: 395
Joined: 4-April 08



Thanks! I'll try that out. I thought about that type of option in this case, but their was quite a bit of talk about not doing that in the various threads I read so I was trying another route first.

Thanks again, I'll see what I can do.
Go to the top of the page
 
GroverParkGeorge
post Nov 1 2019, 10:48 AM
Post#4


UA Admin
Posts: 36,206
Joined: 20-June 02
From: Newcastle, WA


Yes, it's pretty drastic, and I'd not do it in most cases. On the other hand, it's cleaner than trying to anticipate every possible thing users might do or not do.

--------------------
My Real Name Is George. Grover Park Consulting is where I did business for 20 years.
How to Ask a Good Question
Beginning SQL Server
Go to the top of the page
 
tina t
post Nov 1 2019, 01:41 PM
Post#5



Posts: 6,187
Joined: 11-November 10
From: SoCal, USA


i use the same code in my A97 dbs (sans the 64-bit updates), and have for years, and now in the converted-to-A2016 dbs (w/ the 64-bit updates). it works great, except...

in Windows7, and i'm guessing in Windows10 also - i'll find out for sure in a few weeks - you can right click on the taskbar icon and select Close window, and that closes Access - and the open app - right now. unfortunately.

if anyone has found a solution to that issue, that would be great. Colin (isladogs) has some code that will remove the icon in the Windows task bar, but i could only get it to work if i also run his code to hide the database window. some users don't like having the forms "floating" out there without the software window showing, so it's not a guaranteed solution in my case.

if anyone knows how to hide the taskbar icon while still displaying the database window, that would be great. or is there a way to remove the Close window option from the icon's right click menu?

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    14th December 2019 - 10:38 PM