'-----------------------------------------------------------------
' GLOBAL VARIABLE DECLARATION
'-----------------------------------------------------------------
Public dbEmployee As Database
Public tblEmployee As Recordset
'-----------------------------------------------------------------
'-----------------------------------------------------------------
Public Sub InitDB()
' ****************************************************************
' ** Dim the intErrorCount variable at the top of each routine **
' ** and not globally to prevent a count of errors from another **
' ** routine from accidentally being passed into the error **
' ** error handling for this one. **
' ****************************************************************
Dim intErrorCount As Integer
On Error GoTo InitDBError
If Len(AppInfo.DataPath) = 0 Then Err.Raise -8000
intErrorCount = 0
' ****************************************************************
' ** Open the database and the retrieve the table data for use. **
' ****************************************************************
Set dbEmployee = DBEngine.OpenDatabase(AppInfo.DataPath, False, False)
Set tblEmployee = dbEmployee.OpenRecordset("Employee", dbOpenDynaset)
Exit Sub
InitDBError:
' ****************************************************************
' ** If the application was unable to determine the path to the **
' ** Access database, prompt the user for the location of the **
' ** .mdb file. **
' ****************************************************************
If Err.Number = -8000 Then
With frmMain.dlgMain
.InitDir = AppInfo.ApplicationPath
.Filter = "*.mdb"
.ShowOpen
If Len(.FileName) = 0 Then
MsgBox "You did not select a database for the application." & vbcrlf & vbcrlf & _
"Application terminating.", vbOKOnly + vbCritical, "NO DATABASE SELECTED"
End
Else
AppInfo.DataPath = .FileName
End If
End With
Resume Next
' ****************************************************************
' ** If any other error occurred while trying to connect to or **
' ** retrieve data from the Access database, display an error **
' ** and terminate execution of the application. **
' ****************************************************************
Else
If Not DAOErrorRetry(intErrorCount) Then
MsgBox "An error occurred while connecting to the database." & vbcrlf & vbcrlf & _
"Error Number: " & Err.Number & vbcrlf & _
"Error Source: " & Err.Source & vbcrlf & _
"Error Description " & Err.Description & vbcrlf & vbcrlf & _
"Application terminating.", vbOKOnly + vbCritical, "DATABASE CONNECTION FAILED"
Err.Clear
End
Else
intErrorCount = 0
Resume
End If
End If
End Sub
'-----------------------------------------------------------------
'-----------------------------------------------------------------
Private Sub SaveRecord()
Dim intErrorCount As Integer
On Error GoTo SaveRecordError
intErrorCount = 0
With tblEmployee
.FindFirst "EmpID = '" & frmMain.txtMain(0).Text & "'"
If Not tblEmployee.NoMatch Then
.Edit
Else
.AddNew
End If
!FirstName = Trim(frmMain.txtMain(1).Text)
!LastName = Trim(frmMain.txtMain(2).Text)
!Address1 = Trim(frmMain.txtMain(2).Text)
!Address2 = Trim(frmMain.txtMain(2).Text)
!City = Trim(frmMain.txtMain(2).Text)
!State = Trim(frmMain.txtMain(2).Text)
!ZIPCode = Trim(frmMain.txtMain(2).Text)
.Update
End With
Exit Sub
SaveRecordError:
If Not DAOErrorRetry(intErrorCount) Then
MsgBox "An error occurred while attempting to update the employee record." & vbcrlf & vbcrlf & _
"Error Number: " & Err.Number & vbcrlf & _
"Error Source: " & Err.Source & vbcrlf & _
"Error Description " & Err.Description & vbcrlf & vbcrlf & _
"Your changes to this employee were not saved." & vbcrlf & vbcrlf & _
"Please contact the IT HelpDesk for assistance.", vbOKOnly + vbCritical, "UPDATE RECORD FAILED"
Err.Clear
End
Else
intErrorCount = 0
Resume
End If
End Sub
'-----------------------------------------------------------------
'-----------------------------------------------------------------
Private Sub DeleteRecord()
Dim intErrorCount As Integer
On Error GoTo DeleteRecordError
intErrorCount = 0
With tblEmployee
.FindFirst "EmpID = '" & frmMain.txtMain(0).Text & "'"
If Not tblEmployee.NoMatch Then
.Delete
Else
MsgBox "The record for employee number " & frmMain.txtMain(0).Text & " could not be found in the database." & vbcrlf & _
"The record may have already been deleted." & vbcrlf & vbcrlf & _
"If you continue to see this message, please contact the IT HelpDesk for assistance.", _
vbOKOnly + vbInformation, "NO RECORD FOUND."
End If
End With
Exit Sub
DeleteRecordError:
If Not DAOErrorRetry(intErrorCount) Then
MsgBox "An error occurred while attempting to delete the employee record from the database." & vbcrlf & vbcrlf & _
"Error Number: " & Err.Number & vbcrlf & _
"Error Source: " & Err.Source & vbcrlf & _
"Error Description " & Err.Description & vbcrlf & vbcrlf & _
"Please contact the IT HelpDesk for assistance.", vbOKOnly + vbCritical, "DELETE RECORD FAILED"
Err.Clear
End
Else
intErrorCount = 0
Resume
End If
End Sub
Reply With Quote
using the Thread Tools menu ...
