Create Recurring Events

[sherlocked]

Hello experts,

I've been tasked with creating a database to track meetings. I have a table, tblWeeks, that contains each weekday and the date of that weekday for the year 2019. I have a form on which the user enters the start date of the meeting, the day the meeting takes place, how many times it repeats, and whether it is a daily/weekly/bi-weekly/monthly meeting.

The below code works great for a daily meeting, no problem. What I can't figure out is how to move to the next step - if the user wants a bi-weekly Tuesday meeting, how do I search through the table to find the dates and create the records? Using a recordset, there's no "order" to the records and using the rst.Move function doesn't get me the dates I need.

Your assistance as always is appreciated!

Function FindDates()
Dim rsIn As DAO.Recordset
Dim rsOut As DAO.Recordset
Dim Count As Double

Set rsIn = CurrentDb.OpenRecordset("SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#")
    
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Count = 0

rsIn.MoveFirst

Do Until Count = Form_frmDataEntry.txtRecurrence

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Count = Count + 1
Loop

rsOut.Close
rsIn.Close

Set rsIn = Nothing
Set rsOut = Nothing

MsgBox "Your records have been created!", vbOKOnly

 

[theDBguy]

Hi. For the next step, I guess you could check what the user selected. If it's bi-weekly, then you would step your code +14 days instead of just 1 day. If you need to make sure it's on a Tuesday, then you could use the Weekday() function.

 

[MajP]

Using a recordset, there's no "order" to the records

That is only true for your example, nearly all the time the recordset is based on a query or query string.

 

[sherlocked]

That is only true for your example, nearly all the time the recordset is based on a query or query string.

I could certainly make it based on a query easily. Can you step me through how that would help, and what the code might look like?

 

[MajP]

Dim strSql as string
strSql = "Select * from SomeTable ORDER BY someField"
set rs = currentDB.openrecordset(strSql)

But as DBGuy stated you would not have to search for anything. Just loop 7 or 14 days at a time until you come to the last week of the year.

 

[sherlocked]

Appreciate your valuable feedback! Based on your guidance I've amended my code as appears below.

An odd thing though - even when I select "Bi-Weekly" from the dropdown, the code is creating a record for every week. Not sure why - does anything leap out at you?

Function FindDates()
Dim rsIn As DAO.Recordset
Dim rsOut As DAO.Recordset
Dim Recur As Double
Dim strSql As String

Select Case Me.cmboRecurrence

Case "Daily"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 0
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Recur = Recur + 1
Loop

Case "Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 0
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Recur = Recur + 7
Loop

Case "Bi-Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 0
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Recur = Recur + 14
Loop

Case "Monthly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 0
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Recur = Recur + 28
Loop

End Select

rsOut.Close
rsIn.Close

Set rsIn = Nothing
Set rsOut = Nothing

MsgBox "Your records have been created!", vbOKOnly

End Function

 

[theDBguy]

Hi. I see you have a variable called Recur but I don't see that you're using it any meaningful way. What happens if you select Monthly? And unless I am missing it, your SQL statement looks very similar for all cases. If so, then you don't need to define it every time.

 

[sherlocked]

I noticed that as well, almost immediately after posting

I have modified a bit. The SQL is different for daily appointments than it is for recurring, but that is the only difference.

However, now that I am defining the variable "Recur" in each instance (weekly, bi-weekly or monthly meetings) I am still not getting what I want. For example, when selecting bi-weekly recurring Monday meetings starting 1/28/19, I get four records - 1/28/19, 5/6/19, 8/12/19, and 11/18/19. There doesn't seem to be any reason that I can figure out.

Updated code below. Appreciate your willingness to help!

Function FindDates()
Dim rsIn As DAO.Recordset
Dim rsOut As DAO.Recordset
Dim Recur As Double
Dim strSql As String

Select Case Me.cmboRecurrence

Case "Daily"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.MoveNext
Loop

Case "Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 7
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.Move (Recur)
Loop

Case "Bi-Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 14
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.Move (Recur)
Loop

Case "Monthly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

Recur = 28
rsIn.MoveFirst

Do Until rsIn.EOF

rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
rsIn.Move (Recur)
Loop

End Select

rsOut.Close
rsIn.Close

Set rsIn = Nothing
Set rsOut = Nothing

MsgBox "Your records have been created!", vbOKOnly

End Function

 

[theDBguy]

Hi. I think we're missing a big piece of the puzzle. What is in tblWeeks and why are you using it? If you had a start date of today (1/28/2019) and wanted to create three records 2-weeks apart in tblMeetings, you would just loop three times as follows:

For x = 1 to 3
    .AddNew
    .MeetingStart = DateAdd("d", x*14, #1/28/2019#)
    ...
Next

Not exactly correct but you should get the idea...

 

[sherlocked]

Hi,

tblWeeks just has three columns: DayofWeek, SchedDate and Holiday.

I use this because I do not want the database to create appointments indefinitely; only for the current calendar year. Also, on reports, the users want holidays highlighted so that they can be re-scheduled or skipped.

Hope this clarifies

 

[theDBguy]

Hi. Regarding "indefinite appointments," do you think the sample code I posted will create an indefinite appointment because I didn't use tblWeeks. It won't because I specifically told it to create only three (3) records even though I didn't use tblWeeks. Regarding "highlighting holidays," that's okay on reports, but you're not creating a report with the above code. You're trying to populate tblMeetings. For the report, you're free to use tblWeeks to highlight the holidays. Hope it makes sense...

 

[sherlocked]

I dig it. One option I did explore is adding a "recurrence" field on my user form so they could say how many times to repeat the event. so, if they want a bi-weekly event that happens only for the next two months, let's say, they'd enter "4" here.

Can you possibly expand on how your code would look fully fleshed out? I'm a bit of a novice and I'm not sure how to take your snippet and make it something that actually works with what I've already got.

Thanks

 

[theDBguy]

Hi. The user interface could be anything you think is best. The user could enter the number of total occurrences (it was just an example I used) or they could select an end date instead. For example, if they said, create a meeting from today until the end of the year once a month every Monday, that's still possible using code. They won't have to figure out how many meetings they are asking you to make/add into the meetings table. Rather than write the code to explain what I mean, let me see if I can find a link to an example for you. Otherwise, you might consider posting a sample copy of your db with test data, so we can better apply our suggestions to what's really applicable to your situation.

 

[sherlocked]

I appreciate your willingness to dig around.

The part of your snippet that I'm not quite sure of is For x = 1 to 3

Where does this go? How is it used in relationship to the rest of what I have?

 

[theDBguy]

That part is similar to your Do Until rsIn.EOF part. They're both loop constructions. In your code, you're saying repeat the following code for every record in the set; whereas, in my code, I am saying to repeat the code exactly three times.

 

[sherlocked]

Thanks. here's a snippet of how I used it - however the code now hangs up forever and I must CNTRL+BREAK in order to stop it.

Case "Bi-Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

rsIn.MoveFirst

Do Until rsIn!SchedDate = DateAdd("d", 14, Form_frmDataEntry.txtStartDate)
rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = rsIn!SchedDate
rsOut.Update
Loop

 

[Gasman]

Don't you need a rsIn.MoveNext as well ?

 

[sherlocked]

Sure do! This time it created about 1.4 million records with the exact same date of 7/15/19. I just don't know where I'm going wrong here!

 

[theDBguy]

Hi. Gasman was saying you forgot to add the .MoveNext part in your code. It should go something like this:

Do Until loop here...
    .AddNew here
    .Other stuff here
    .Update here
    .MoveNext here
Loop

Without the .MoveNext command, the loop will just stay on the same record and never stop because it'll never hit the .EOF.

 

[sherlocked]

Fiddled more. Got it to actually create some records with the below. However it appears to have spontaneously, for no reason I can determine, started creating records every THREE weeks instead after March 4th. I am so confused, lol!

Here's my code for bi-weekly meetings now below - and here are the dates that were created:

Did not create 1/28/19 as it should start with, not sure why
2/11/2019 - great
3/4/2019 - great
3/25/2019 - skipped to three weeks!
4/15/2019
5/6/2019
5/27/2019
6/17/2019
7/8/2019
7/29/2019
8/19/2019
9/9/2019
9/30/2019
10/21/2019
11/11/2019
12/2/2019
12/23/2019
1/13/2020
2/3/2020
2/24/2020
3/16/2020
4/6/2020
4/27/2020
5/18/2020
6/8/2020
6/29/2020
7/20/2020

Case "Bi-Weekly"

strSql = "SELECT tblWeeks.DayofWeek, tblWeeks.SchedDate FROM tblWeeks " _
    & "WHERE tblWeeks.DayofWeek = '" & Form_frmDataEntry.txtDayofWeek & "' " _
    & "AND tblWeeks.SchedDate > #" & Form_frmDataEntry.txtStartDate & "# OR tblWeeks.SchedDate = #" & Form_frmDataEntry.txtStartDate & "#"

Set rsIn = CurrentDb.OpenRecordset(strSql)
Set rsOut = CurrentDb.OpenRecordset("tblMeeting", dbOpenDynaset)

rsIn.MoveFirst

For x = 1 To 26
rsOut.AddNew
rsOut!MeetingType = Form_frmDataEntry.txtMeetingName
rsOut!MeetingStart = DateAdd("d", x * 14, rsIn!SchedDate)
rsOut.Update
rsIn.MoveNext
Next