Open form to todays date, if date does not exist add it 1

[striker83716]

This should have a very simple solution, but I am struggling to find the answer.

I have 3 tables
tblEmployee idEmployee(PK) Fname Lname Address etc
tblDate idDate(pk) DateWorked(no duplicates)
tbldetails idEmployee(PK) idDate(PK) hours AbsenceCode Comments.


I have a form frmAttendance it has 1 textbox on it txtDateWorked. This forms control record source tblDate.

Also on frmAttendance is a subform titled subfrmEmployees based off of a table (tbldetails). related on idDate

Finally I have an append query that creates a detail record for each employee, for each date

On opening of the form I want the form to open to today's date (all other dates being accessible using the navigation buttons, calendar control etc). If todays date is not in the database, I want to add the date in VB to the tblDate, then run the append query using this date, thus creating a detail record for each employee for the new date, and finally opening the frmAttendance to the newly added Current date showing all employee details.

What would my best approach to solve this

if tbldate has todays date in it goto that record if not add and append.

Thanks in advance

 

[NorthNone]

I use this code if a PKey doesn't exist to add a record to the PrematriculationRecords table. Maybe this will help? I don't know if it exactly applies, but seemed similar enough to post. HTH JeanS

(This is an ADO recordset)
'find out if treatment records exist for this PKey
dblPKey = Forms!SearchPersons.PKey
strSQL = "SELECT PKEY "
strSQL = strSQL & "FROM PrematriculationRecords "
strSQL = strSQL & "WHERE PKey = " & dblPKey & ";"
'' Open the connection
rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockOptimistic
If rst.RecordCount > 0 Then
‘exit sub
GoTo EXITAddPreMat
Else
strSQL = "INSERT INTO PrematriculationRecords(PKey) " & _
"SELECT " & dblPKey & " As Expr1;"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
'NOTE: error handler turns SetWarnings ON in case of error Never use SetWarnings False without an error handler.

 

[striker83716]

Thanks for your help NorthNone, I was able to adapt your code for my application. I thought I should post it for others.


Private Sub Form_Load()
On Error GoTo Err_form_load


Dim cnCurrent As ADODB.Connection
Dim rsDateFind As ADODB.Recordset
Set cnCurrent = CurrentProject.Connection
Set rsDateFind = New ADODB.Recordset
Dim strsql As String
Dim strUpdate As String
Dim strUpdate2 As String
strsql = "SELECT tblDate.* FROM tblDate WHERE (((tblDate.DateWorked)=Date()));"
strUpdate = "INSERT INTO tblDate ( DateWorked ) SELECT Date() AS Expr1 FROM tblDate;"
strUpdate2 = "INSERT INTO tblDetails ( IDEmployee, IDDate ) " & _
"SELECT tblEmployees.IDEmployee, tblDate.DateID " & _
"FROM tblEmployees, tblDate " & _
"WHERE (((tblEmployees.Terminated)=No) AND ((tblDate.dateadded)>=Date()));"
rsDateFind.Open strsql, cnCurrent, adOpenStatic, adLockOptimistic

If rsDateFind.RecordCount = 0 Then
'Today's date was not found, so lets add it to the tbldate and then append the tbldetails
DoCmd.SetWarnings False
DoCmd.RunSQL strUpdate
DoCmd.RunSQL strUpdate2
DoCmd.Requery
DoCmd.SetWarnings True

Else
'Today's date was found in the database

End If

txtdatefind.SetFocus
DoCmd.FindRecord Date
Me![qryDetailsDate subform].SetFocus

rsDateFind.Close
cnCurrent.Close
Set rsDateFind = Nothing
Set cnCurrent = Nothing

Exit_Form_Load:
Exit Sub

Err_form_load:
DoCmd.SetWarnings
MsgBox Err.Description
Resume Exit_Form_Load

End Sub