How To Calculate Date Intervals With VBA DateAdd
by admin on Saturday, September 15th, 2018 | No Comments
One of my clients ask me to design a little utility to operate like the Outlook appointment
recurrence feature.
This the first basic step, so I wanted to share how I did it.
I have a basic form where I’ll probably be adding more variables, but the functionality basically works like this:
I have an input box for the start date, and how many times the occurrence should happen, and then at what frequency (monthly, quarterly, yearly, or semiannually)
Option Compare Database '----------------------------------- 'CODE BY LOEBLCOMSERVICES 2018 'erik@loeblcomservices.com '----------------------------------- Private Sub Form_Load() 'Initialize the text boxes Me.txtStartDate = Date Me.txtRecur = 1 End Sub Private Sub btnAddNew_Click() Dim intFrequency As Integer 'Get the first date dteStartDate = CDate(Me.txtStartDate) 'How many date intervals will we need? Default to 1, if this is blank. intFrequency = Nz(Me.txtRecur, 1) 'Delete what's currently in the table CurrentDb.Execute "DELETE * FROM tblFrequencies" 'Select the date frequency based on an option group, and pass the _ required information to the next procedure. Select Case Me.fraFrequency Case 1 'monthly Frequencies dteStartDate, "m", 1, intFrequency Case 2 'quarterly Frequencies dteStartDate, "m", 3, intFrequency Case 3 'yearly Frequencies dteStartDate, "m", 12, intFrequency Case 4 'semi annually Frequencies dteStartDate, "m", 6, intFrequency End Select DoCmd.OpenQuery "qryFrequencies" End Sub Sub Frequencies(dteStartDate, interval, subinterval, times) 'Insert the start date into the table CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(1,'" & dteStartDate & "')" 'Get the next date due by using the DateAdd function dteNextDueDate = DateAdd(interval, subinterval, dteStartDate) Debug.Print "Next Date Due= " & dteNextDueDate 'Insert the next date due. CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(2,'" & dteNextDueDate & "')" 'Alternate between the next 2 procedures until the "times" variable is reached Getdates1 dteNextDueDate, interval, subinterval, 2, times End Sub Sub Getdates1(NextDueDate, interval, intSubInterval, current, TotalTimes) If current < TotalTimes Then 'Use the DateAdd function again to get the next iteration date dteNextDueDate = DateAdd(interval, intSubInterval, NextDueDate) Debug.Print dteNextDueDate 'Increment the counter to pass to the next procedure current = current + 1 'Insert the value CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(" & current & ",'" & dteNextDueDate & "')" Getdates2 dteNextDueDate, interval, intSubInterval, current, TotalTimes End If End Sub Sub Getdates2(NextDueDate, interval, intSubInterval, current, TotalCt) 'Use the DateAdd function again to get the next due date dteNextDueDate = DateAdd(interval, intSubInterval, NextDueDate) Debug.Print dteNextDueDate 'Increment the counter to pass to the next procedure current = current + 1 'Insert the value CurrentDb.Execute "INSERT INTO tblFrequencies (DateNum,NewDate) VALUES(" & current & ",'" & dteNextDueDate & "')" 'Call the first procedure again until the interval is reached Getdates1 dteNextDueDate, interval, intSubInterval, current, TotalCt End Sub
Click here to download the sample database: “How To Calculate Date Intervals With VBA DateAdd”