Programatically create and display new records on bound form

[Keepitlive]

I have a form/subform bound to 2 tables in a 1-to-many relationship.

On the main form, the user is prompted to enter (among other things)
the start and end dates for a course, as well as the day of the week
that the individual sessions take place.

Using this information, I would like to generate a record for every
date within the date range that falls on the specified day of the week
and display the new records in the subform.

Being a novice VBA programmer, most of this is a problem to work out
(e.g. calculating the dates), but the main one is how to actually
create the records.

Thanks in anticipation for any help you can offer.

 

[Bob Quintal]

I have a form/subform bound to 2 tables in a 1-to-many
relationship.

On the main form, the user is prompted to enter (among other
things) the start and end dates for a course, as well as the day
of the week that the individual sessions take place.

Using this information, I would like to generate a record for
every date within the date range that falls on the specified day
of the week and display the new records in the subform.

Being a novice VBA programmer, most of this is a problem to work
out (e.g. calculating the dates), but the main one is how to
actually create the records.

Thanks in anticipation for any help you can offer.

Use the dateadd function to add 1 week to the date, create the SQL
statement to add the courseID and Date to the subtable, loop until
the date variable is > enddate.

Something to start with in a button that runs the routine:

DateValue = me!txtStartDate
Do while datevalue <= me!txtEndDate
strSQL = "INSERT INTO subtable " _
& "(field1,field2) Values " _
& "(" & me!CourseID" & "," & datevalue & ");"
Docmd.runsql strSQL
Datevalue = dateadd("ww",1,datevalue)
loop
me.subformcontrol.requery

 

[Allen Browne]

The dates will have to come from somewhere, so you will need a table of
dates to draw from. Create a table with just one field of type Date/Time
named TheDate. Make it the primary key. Save the table as ltDate. Enter all
the dates for the range would could ever need.

Now use something like this code to append the dates. The example is a
cut-down of some code that adds the dates in a semester for a particular
weekday as the dates of a class. In this example:
- ClassStart is a combo that identifies the semester (Jan 1, or July 1 of
some year)
- cboDOW is a combo identifying the Day-of-the-week (1 to 7)
- ltDate is the lookup table containing about 20 years worth of dates
- tblClassDate is the target table.
- The dates are added by executing an append query statement.

Hope it helps you identify how to approach this.

Private Sub cmdAppendDate_Click()
On Error GoTo Err_Handler
'Purpose: Insert the class dates for the semester.
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String
Dim strStartDate As String
Dim strEndDate As String
Dim strMsg As String
Dim bCancel As Boolean
Dim lngKt As Long

Set db = DBEngine(0)(0)

'Save first.
If Me.Dirty Then
Me.Dirty = False
End If
'Must have a record.
If Me.NewRecord Then
bCancel = True
strMsg = strMsg & "Enter the class first." & vbCrLf
End If
'Must have a day of the week.
If IsNull(Me.cboDOW) Then
bCancel = True
strMsg = strMsg & "Choose a week day." & vbCrLf
Me.cboDOW.SetFocus
End If

If Not bCancel Then
If Month(Me.ClassStart) >= 7 Then
strStartDate = "#7/1/" & Year(Me.ClassStart) & "#"
strEndDate = "#12/31/" & Year(Me.ClassStart) & "#"
Else
strStartDate = "#1/1/" & Year(Me.ClassStart) & "#"
strEndDate = "#6/30/" & Year(Me.ClassStart) & "#"
End If
strSql = "INSERT INTO tblClassDate ( ClassID, ClassDate ) " & vbCrLf
& _
"SELECT " & Me.ClassID & " AS ClassID, ltDate.TheDate, " &
vbCrLf & _
"FROM ltDate " & vbCrLf & _
"WHERE ((ltDate.TheDate Between " & strStartDate & " And " &
strEndDate & ") AND (Weekday(ltDate.TheDate) = " & Me.cboDOW & ") " & vbCrLf
& _
"AND NOT EXISTS (SELECT ClassDateID FROM tblClassDate AS Dupe
WHERE ((Dupe.ClassID = " & Me.ClassID & ") AND (Dupe.ClassDate =
ltDate.TheDate)))) " & vbCrLf & _
"ORDER BY ltDate.TheDate;"
db.Execute strSql, dbFailOnError
lngKt = db.RecordsAffected
Select Case lngKt
Case 0&
bCancel = True
strMsg = "No dates need adding, or there are no dates defined."
Case 1&
strMsg = "1 record added."
Me.frmClassDate.Requery
Case Else
strMsg = lngKt & " records added."
Me.frmClassDate.Requery
End Select
End If

If bCancel Then
If strMsg <> vbNullString Then
MsgBox strMsg, vbExclamation, "Cannot add dates."
End If
Else
If strMsg <> vbNullString Then
MsgBox strMsg, vbInformation, "Results"
End If
End If

Exit_Handler:
Set rs = Nothing
Set db = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description
Resume Exit_Handler
End Sub

 

[Keepitlive]

Use the dateadd function to add 1 week to the date, create the SQL
statement to add the courseID and Date to the subtable, loop until
the date variable is > enddate.

Something to start with in a button that runs the routine:

DateValue = me!txtStartDate
Do while datevalue <= me!txtEndDate
strSQL = "INSERT INTO subtable " _
& "(field1,field2) Values " _
& "(" & me!CourseID" & "," & datevalue & ");"
Docmd.runsql strSQL
Datevalue = dateadd("ww",1,datevalue)
loop
me.subformcontrol.requery

Thanks, Allen and Bob, for your replies. For the sake of brevity (and
my ability to understand it), I am trying to make use of Bob's code.
To test the technique (the detail not exactly as I first specified), I
created a form with 2 unbound text boxes:

- txtSelectStartDate
- txtSelectEndDate

(both with a Short Date format)

and a command button with the folllowing On Click event code:

DoCmd.SetWarnings False
Dim datDateVal As Date
datDateVal = Me!txtSelectStartDate
Do While datDateVal <= Me!txtSelectEndDate
strsql = "INSERT INTO tblCourseExceptionDate (ExceptionDate)
Values (#" & datDateVal & "#);"
DoCmd.RunSQL strsql
datDateVal = DateAdd("d", 1, datDateVal)
Loop
Me.Requery
DoCmd.SetWarnings True

With the value 01/01/2007 in txtSelectStartDate and 14/01/2007 in
txtSelectEndDate, the above code creates 14 records as planned, but
the values in database field ExceptionDate (Date/Time with Short Date
format) are odd.

Formatted on screen as Long Date, they are:

01 January 2007
01 February 2007
01 March 2007 and the first of each month until

01 December 2007 then

13 January 2007
14 January 2007

So it starts and finishes OK, but appears to be adding months instead
of days in the middle.
Any ideas?
Thanks

Chas

 

[Bob Quintal]

Thanks, Allen and Bob, for your replies. For the sake of brevity
(and my ability to understand it), I am trying to make use of
Bob's code. To test the technique (the detail not exactly as I
first specified), I created a form with 2 unbound text boxes:

- txtSelectStartDate
- txtSelectEndDate

(both with a Short Date format)

and a command button with the folllowing On Click event code:

DoCmd.SetWarnings False
Dim datDateVal As Date
datDateVal = Me!txtSelectStartDate
Do While datDateVal <= Me!txtSelectEndDate
strsql = "INSERT INTO tblCourseExceptionDate
(ExceptionDate)
Values (#" & datDateVal & "#);"
DoCmd.RunSQL strsql
datDateVal = DateAdd("d", 1, datDateVal)
Loop
Me.Requery
DoCmd.SetWarnings True

With the value 01/01/2007 in txtSelectStartDate and 14/01/2007 in
txtSelectEndDate, the above code creates 14 records as planned,
but the values in database field ExceptionDate (Date/Time with
Short Date format) are odd.

Formatted on screen as Long Date, they are:

01 January 2007
01 February 2007
01 March 2007 and the first of each month until

01 December 2007 then

13 January 2007
14 January 2007

So it starts and finishes OK, but appears to be adding months
instead of days in the middle.
Any ideas?
Thanks

Chas

Allen explains this issue on his site
http://allenbrowne.com/ser-36.html

change the SQL statement
from
Values (#" & datDateVal & "#)
to
Values (#" & Format$(datDateVal, "\#mm\/dd\/yyyy\#") & "#)

 

[Keepitlive]

Allen explains this issue on his sitehttp://allenbrowne.com/ser-36.html

change the SQL statement
from
Values (#" & datDateVal & "#)
to
Values (#" & Format$(datDateVal, "\#mm\/dd\/yyyy\#") & "#)

Bob, thanks again for your time and effort. Problem solved.