Quit Access after running backup vba

Question

Hello,

On a form I have a button which I want to use to not only create a backup of the access database using the OnClick as =fMakeBackup() which in turn runs the below module but I would also like it to quit the access program and application after running the backup operation.

What expression should be added and where exactly should it be added to do this?

Option Compare Database

Private Type SHFILEOPSTRUCT

    hwnd As Long

    wFunc As Long

    pFrom As String

    pTo As String

    fFlags As Integer

    fAnyOperationsAborted As Boolean

    hNameMappings As Long

    lpszProgressTitle As String

End Type

Private Const FO_MOVE As Long = &H1

Private Const FO_COPY As Long = &H2

Private Const FO_DELETE As Long = &H3

Private Const FO_RENAME As Long = &H4

Private Const FOF_MULTIDESTFILES As Long = &H1

Private Const FOF_CONFIRMMOUSE As Long = &H2

Private Const FOF_SILENT As Long = &H4

Private Const FOF_RENAMEONCOLLISION As Long = &H8

Private Const FOF_NOCONFIRMATION As Long = &H10

Private Const FOF_WANTMAPPINGHANDLE As Long = &H20

Private Const FOF_CREATEPROGRESSDLG As Long = &H0

Private Const FOF_ALLOWUNDO As Long = &H40

Private Const FOF_FILESONLY As Long = &H80

Private Const FOF_SIMPLEPROGRESS As Long = &H100

Private Const FOF_NOCONFIRMMKDIR As Long = &H200

Private Declare Function apiSHFileOperation Lib "Shell32.dll" _

            Alias "SHFileOperationA" _

            (lpFileOp As SHFILEOPSTRUCT) _

            As Long

Function fMakeBackup() As Boolean

Dim strMsg As String

Dim tshFileOp As SHFILEOPSTRUCT

Dim lngRet As Long

Dim strSaveFile As String

Dim lngFlags As Long

Const cERR_USER_CANCEL = vbObjectError + 1

Const cERR_DB_EXCLUSIVE = vbObjectError + 2

    On Local Error GoTo fMakeBackup_Err

    If fDBExclusive = True Then Err.Raise cERR_DB_EXCLUSIVE

    strMsg = "A copy of this Database will be placed in a subfolder called Backups located in the the same folder where this database resides with a Date and time stamp as part of the file name."

    If MsgBox(strMsg, vbQuestion + vbYesNo, "Please confirm") = vbNo Then _

            Err.Raise cERR_USER_CANCEL

    lngFlags = FOF_SIMPLEPROGRESS Or _

                            FOF_FILESONLY Or _

                            FOF_RENAMEONCOLLISION

    'Original. This one saves but doesn't add the date to the file name.

    'strSaveFile = CurrentDb.Name

  strSaveFile = Left$(CurrentDb.Name, InStrRev(CurrentDb.Name, "")) & "Backups" & Format$(Now, "yyyy-mm-dd hh-nn ") & Mid$(CurrentDb.Name, InStrRev(CurrentDb.Name, "") + 1)

    With tshFileOp

        .wFunc = FO_COPY

        .hwnd = hWndAccessApp

        .pFrom = CurrentDb.Name & vbNullChar

        .pTo = strSaveFile & vbNullChar

        .fFlags = lngFlags

    End With

    lngRet = apiSHFileOperation(tshFileOp)

    fMakeBackup = (lngRet = 0)

fMakeBackup_End:

    Exit Function

fMakeBackup_Err:

    fMakeBackup = False

    Select Case Err.Number

        Case cERR_USER_CANCEL:

            'do nothing

        Case cERR_DB_EXCLUSIVE:

            MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _

                    vbCrLf & "is opened exclusively.  Please reopen in shared mode" & _

                    " and try again.", vbCritical + vbOKOnly, "Database copy failed"

        Case Else:

            strMsg = "Error Information..." & vbCrLf & vbCrLf

            strMsg = strMsg & "Function: fMakeBackup" & vbCrLf

            strMsg = strMsg & "Description: " & Err.Description & vbCrLf

            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf

            MsgBox strMsg, vbInformation, "fMakeBackup"

    End Select

    Resume fMakeBackup_End

    'DoCmd.Quit

End Function

Private Function fCurrentDBDir() As String

'code courtesy of

'Terry Kreft

Dim strDBPath As String

Dim strDBFile As String

    strDBPath = CurrentDb.Name

    strDBFile = Dir(strDBPath)

    fCurrentDBDir = Left(strDBPath, InStr(strDBPath, strDBFile) - 1)

End Function

Function fDBExclusive() As Integer

Dim db As Database

Dim hFile As Integer

    hFile = FreeFile

    Set db = CurrentDb

    On Error Resume Next

    Open db.Name For Binary Access Read Write Shared As hFile

    Select Case Err

        Case 0

            fDBExclusive = False

        Case 70

            fDBExclusive = True

        Case Else

            fDBExclusive = Err

    End Select

    Close hFile

    On Error GoTo 0

End Function

'************* Code End ***************

Answer 1

The command is:

Application.Quit(acQuitSaveNone)

You can call it when you have confirmed a successful copy.

That said, your method isn't the best, as the database file itself should be closed before copying it.

Answer 2

Understood, however given the current circumstance i would like to continue with the backup method. Where exactly would i put the expression you mentioned in my vba?

Answer 3

Before:

Exit Function