Create Recurring Events (1 Viewer)

S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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!

Code: 
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
 
Last edited:
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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

MajP

You've got your good things, and you've got mine.
Local time
Yesterday, 21:19
Joined
May 21, 2018
Messages
8,525
Using a recordset, there's no "order" to the records
Click to expand...
That is only true for your example, nearly all the time the recordset is based on a query or query string.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
MajP said:
That is only true for your example, nearly all the time the recordset is based on a query or query string.
Click to expand...

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

MajP

You've got your good things, and you've got mine.
Local time
Yesterday, 21:19
Joined
May 21, 2018
Messages
8,525
Code: 
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.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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?

Code: 
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
I noticed that as well, almost immediately after posting :p

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!

Code: 
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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:
Code: 
For x = 1 to 3
    .AddNew
    .MeetingStart = DateAdd("d", x*14, #1/28/2019#)
    ...
Next
Not exactly correct but you should get the idea...
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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...
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
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.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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.

Code: 
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

Gasman

Enthusiastic Amateur
Local time
Today, 02:19
Joined
Sep 21, 2011
Messages
14,238
Don't you need a rsIn.MoveNext as well ?
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 18:19
Joined
Oct 29, 2018
Messages
21,454
Hi. Gasman was saying you forgot to add the .MoveNext part in your code. It should go something like this:
Code: 
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.
 
S

sherlocked

Registered User.
Local time
Yesterday, 18:19
Joined
Sep 22, 2014
Messages
125
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

Code: 
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
 
You must log in or register to reply here.

Similar threads

A
TSBAPI_GetSaveFileName works in 32 BIT, but not in 64 BIT
Replies
1
Views
1,799
The_Doc_Man
The_Doc_Man

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom