Access TimeClock Form

[scgamecock]

I have created two tables: Employees & TimeClock. I have created a form called ClockIn.

What I am trying to do is have the form to check if the employeename and password matches what is in the Employees Table. if that matches then the employee is able to clockin. When the employee clocks in, the data is sent to the TimeClock Table. Once the Employees Table has been checked, the data matched, then the form determines if today's date matches any value in the TimeClock table with the employeename. If it does not match, then a new record is suppose to be created.

As of right now, a new record is not created. The row containing the employeename is just updated.

Here is the code I have so far:

Option Explicit
Option Compare Database
Private intLogonAttempts As Integer
Public MyEmpName As String

Private Sub Form_Open(Cancel As Integer)
'On open set focus to combo box
Me.txtEmployeeName.SetFocus
'Me.txtEmployeename.Value = ""
Me.txtClockInDate.Value = Format(Now, "mmm d yyyy")

If Me.txtEmployeeName.Text <> "" Then
    DoCmd.GoToRecord , , acLast
    DoCmd.GoToRecord , , acNext
    
    Exit Sub
End If

'MsgBox Me.txtEmployeename.Value

intLogonAttempts = 0

End Sub

Private Sub Form_Timer()
    Me!lblClock.Caption = Format(Now, "dddd, mmm d yyyy, hh:mm:ss AMPM")
End Sub

Private Sub txtEmployeeName_AfterUpdate()
'After selecting user name set focus to password field
Me.txtPassword.SetFocus
End Sub

Private Sub cmdClockIn_Click()

Dim blnFound As Boolean

blnFound = False

    'Check to see if data is entered into the UserName Textbox

    If IsNull(Me.txtEmployeeName) Or Me.txtEmployeeName = "" Then
            MsgBox "Employee Name is a required field.", vbOKOnly, "Required Data"
            Me.txtEmployeeName.SetFocus
        Exit Sub
    End If

    'Check to see if data is entered into the password box

    If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
            MsgBox "Password is a required field.", vbOKOnly, "Required Data"
            Me.txtPassword.SetFocus
        Exit Sub
    End If

    'Check value of password in Employees to see if this matches value entered into textbox

    If Me.txtPassword = DLookup("Password", "Employees", "EmployeeName='" & Me.txtEmployeeName.Value & "'") Then

        MyEmpName = Me.txtEmployeeName.Value
        
        'blnFound = True
        
     Else
     
        MsgBox "Employee Name or Password Invalid.  Please Try Again", vbOKOnly, "Invalid Entry!"
        Me.txtEmployeeName.SetFocus
        Me.txtEmployeeName = ""
        Me.txtPassword = ""
        
        Exit Sub
        
    End If
    
'If User Enters incorrect password 3 times database will shutdown
    
    intLogonAttempts = intLogonAttempts + 1
    If intLogonAttempts = 3 Then
        MsgBox "You do not have access to this database.  Please contact your system administrator.", vbCritical, "Access is Denied!"
        Application.Quit
    End If
    
    Dim fldItem As ADODB.Field
    Dim fldItem2 As ADODB.Field
    Dim rstTimeClock As ADODB.Recordset
    Dim strDate As String
    
    Set rstTimeClock = New ADODB.Recordset
    rstTimeClock.Open _
        "SELECT * FROM TimeClock WHERE EmployeeName = '" & _
            txtEmployeeName & "'", _
                CurrentProject.Connection, _
                    adOpenStatic, adLockReadOnly, adCmdText
    
    With rstTimeClock
    'Check each record
    While Not .EOF
        'Check the name of the column
        For Each fldItem In .Fields
            'if the current column is Password
        'If fldItem.Name = "ClockIn" Then
                'Check the value
                'If the current column holds the same employee password
                'the employee entered
                If fldItem.Value <> Me.txtClockInDate.Value Then
                    '... then get the record and display
                    'the full name in the controls
                    'Me.txtEmployeeName = .Fields("EmployeeName")
                    '.Fields("EmployeeName") = Me.txtEmployeeName.Value
                    
                    blnFound = True
                
                Else
                
                    MsgBox "You have all ready clocked in today."
                    
                End If
            End If
        Next
        'In case it was not found, move to the next record
        rstTimeClock.MoveNext
    Wend
End With

    If blnFound = True Then
        On Error GoTo Err_cmdClockIn_Click
    
    DoCmd.GoToRecord , , acNewRec
    

Exit_cmdClockIn_Click:
    Exit Sub

Err_cmdClockIn_Click:
    MsgBox Err.Description
    Resume Exit_cmdClockIn_Click
    
End If

Application.Quit

End Sub

 

[CraigDolphin]

If it does not match, then a new record is suppose to be created.

DoCmd.GoToRecord , , acNewRec

All this bit of code does is move the form to a new (blank) record. Nothing will be saved to the table until the user enters something into one of the form controls and then closes the form or moves to another record.

If you want to create a new record in your TimeClock table directly from code then you can do this using the sql INSERT INTO syntax (you need to create the sql string and save it as a string variable strSQL then use docmd.runSQL strSQL)

the sql would take the general form:
INSERT INTO table_name (field1, field2,...)
VALUES (value1, value2,....)

also, the line ...

On Error GoTo Err_cmdClockIn_Click

... is oddly placed here. This is usually placed directly after the sub's first line.
Not sure if this will cause you any problems as is but it wouldn't hurt to put it at the front of the queue.
i.e.,

Private Sub cmdClockIn_Click()
On Error GoTo Err_cmdClockIn_Click
Dim blnFound As Boolean

 

[scgamecock]

Is this how it should look?

If blnFound = True Then
    
    Dim strSQL As String
    
strSQL = "INSERT INTO TimeClock (EmployeeName, ClockIn) values ( Me.txtEmployeename, Me.txtClockInDate )"

DoCmd.RunSQL strSQL

Also, is there any of my original code that is not needed?

 

[CraigDolphin]

Not quite...try...

If blnFound = True Then
    
    Dim strSQL As String
    
strSQL = "INSERT INTO TimeClock (EmployeeName, ClockIn) values ('" & Me.txtEmployeename & "',#" & Me.txtClockInDate & "#);"

DoCmd.RunSQL strSQL

As for the remainder of your code....I don't know if any of it is redundant or not. If it works for your purposes then leave it in.