Private Sub cmdQuit_Click()
On Error GoTo ErrH
If strUser = "User1" Or strUser = "User2" Then
Response = MsgBox("Wollen sie das Program beenden und ein Backup der Datenbank erstellen?", vbYesNo + vbQuestion, "Beenden")
Else
Response = MsgBox("Wollen sie das Program beenden?", vbYesNo + vbQuestion, "Beenden")
End If
If Response = vbYes Then
OldName = "X:\Container........DATEN.accdb"
NewName = "X:\Container..........DATENBackup.accdb"
retval = 0
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
retval = objFSO.CopyFile(OldName, NewName, True)
Set objFSO = Nothing
If strUser = "User1" Or strUser = "User2" Then
OldName2 = "X:\Container..........DATEN.accdb"
NewName2 = "C:\DATENBackup.accdb"
retval = 0
Dim objFSO2 As Object
Set objFSO2 = CreateObject("Scripting.FileSystemObject")
retval = objFSO2.CopyFile(OldName2, NewName2, True)
Set objFSO2 = Nothing
End If
Application.Quit
End If
'ErrorHandler
Exit_ErrH:
Exit Sub
ErrH:
Dim ErrNr, ErrB, ErrD, ErrSB, Nachricht, ErrC, ErrF As Variant
ErrNr = Nz(Err.Number, 0)
ErrB = Nz(Err.Description, "Keine Beschreibung")
ErrD = Now()
ErrSB = Nz(strUser, "Nicht indentifiziert")
ErrC = "cmdQuit_Click"
ErrF = Me.Form.Name
Nachricht = "Fehler!" & vbNewLine & "Fehler Nummer: " & ErrNr & vbNewLine & "Fehler Beschreibung: " & ErrB & vbNewLine & vbNewLine & "Der Fehler wird gespeichert und eine Nachricht wird zum Administrator gesendet"
MsgBox Nachricht, vbCritical, "Fehler!"
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO ErrorH " & _
"( [ErrNr],[ErrB],[ErrD],[ErrSB],[ErrC],[ErrF]) " & _
"VALUES (""" & ErrNr & """,""" & ErrB & """,""" & ErrD & """,""" & ErrSB & """,""" & ErrC & """,""" & ErrF & """)"
DoCmd.SetWarnings True
DoCmd.SendObject acSendNoObject, , , "myemail@adress", , , "Fehler Meldung", "Fehler!" & vbNewLine & "Fehlernummer: " & ErrNr & vbNewLine & "Fehlerbezeichnung: " & ErrB & vbNewLine & "Fehler im Formilar: " & ErrF & vbNewLine & "Fehler in Funktion: " & ErrC & vbNewLine & "Fehler Zeit: " & ErrD & vbNewLine & "Fehler bei Sachbearbeiter: " & ErrSB, False
Resume Exit_ErrH
End Sub