Option Compare Database
Public intAccrual1 'Days that accrue in January of current year
Public intAccrual2 'Days that accrue in Feb of current year
Public intAccrual3 'Days that accrue in Mar of current year
Public intAccrual4 'Days that accrue in April of current year
Public intAccrual5 'Days that accrue in May of current year
Public intAccrual6 'Days that accrue in June of current year
Public intAccrual7 'Days that accrue in July of current year
Public intAccrual8 'Days that accrue in August of current year
Public intAccrual9 'Days that accrue in Sept of current year
Public intAccrual0 'Days that accrue in Oct of current year
Public intAccrual11 'Days that accrue in Nov of current year
Public intAccrual12 'Days that accrue in Dec of current year
Const Form_Name = "mod_Accounting"
Public Sub MonthlyAccrual()
'Determine the number of vacation days that accrue
'each month during the current year
'Calculation done on a daily basis (i.e., a time period represents a percent of the year, not the mth)
'Open recordsets for two tables: tbl_AnnualVacation and tbl_PercentWork
Dim rstAnnualVacation As ADODB.Recordset
Dim rstPercentWork As ADODB.Recordset
Dim sql As String
Dim d, FirstDayOfThisYear, LastDayOfThisYear, FromDate As Date
Dim i
FirstDayOfThisYear = DateSerial(Year(Date), 1, 1)
LastDayOfThisYear = DateSerial(Year(Date), 12, 31)
'Set variables for mthly accrued days to zero
intAccrual1 = 0
intAccrual2 = 0
intAccrual3 = 0
intAccrual4 = 0
intAccrual5 = 0
intAccrual6 = 0
intAccrual7 = 0
intAccrual8 = 0
intAccrual9 = 0
intAccrual0 = 0
intAccrual11 = 0
intAccrual12 = 0
Set rstAnnualVacation = New ADODB.Recordset
Set rstPercentWork = New ADODB.Recordset
'Open recordsets
sql = "SELECT tbl_AnnualVacation.* FROM tbl_AnnualVacation;"
rstAnnualVacation.Open sql, CurrentProject.Connection, _
adOpenStatic, adLockOptimistic
sql = "SELECT tbl_PercentWork.* FROM tbl_PercentWork;"
rstPercentWork.Open sql, CurrentProject.Connection, _
adOpenStatic, adLockOptimistic
For d = FirstDayOfThisYear To LastDayOfThisYear
'Annual Vacation Days
'Find the most recent date that is less than the date of this year under consideration
FromDate = #1/1/1900#
rstAnnualVacation.MoveFirst
rstAnnualVacation.MoveLast
Do Until rstAnnualVacation.BOF
If d >= rstAnnualVacation.Fields("FromDate") And rstAnnualVacation.Fields("FromDate") > FromDate Then
FromDate = rstAnnualVacation.Fields("FromDate")
End If
rstAnnualVacation.MovePrevious
Loop
'Set i = the number of annual vacation days as of that date
rstAnnualVacation.MoveFirst
rstAnnualVacation.Find "FromDate=" & CStr(FromDate)
i = rstAnnualVacation.Fields("AnnualVacation") 'Number of vacation days as of given date
'Percent work
'Find the most recent date that is less than the date of this year under consideration
FromDate = #1/1/1900#
rstPercentWork.MoveFirst
rstPercentWork.MoveLast
Do Until rstPercentWork.BOF
If d >= rstPercentWork.Fields("FromDate") And rstPercentWork.Fields("FromDate") > FromDate Then
FromDate = rstPercentWork.Fields("FromDate")
End If
rstPercentWork.MovePrevious
Loop
'Set i = the number of annual vacation days as of that date
rstPercentWork.MoveFirst
rstPercentWork.Find "FromDate=" & CStr(FromDate)
i = ((i * rstPercentWork.Fields("PercentWork")) / 100) / 365 'Accrued daily vacation
'Allocate acccrued daily vacation to correct month variable
Select Case Month(d)
Case 1 'January
intAccrual1 = intAccrual1 + i
Case 2 'February
intAccrual2 = intAccrual2 + i
Case 3 'March
intAccrual3 = intAccrual3 + i
Case 4 'April
intAccrual4 = intAccrual4 + i
Case 5 'May
intAccrual5 = intAccrual5 + i
Case 6 'June
intAccrual6 = intAccrual6 + i
Case 7 'July
intAccrual7 = intAccrual7 + i
Case 8 'August
intAccrual8 = intAccrual8 + i
Case 9 'September
intAccrual9 = intAccrual9 + i
Case 10 'October
intAccrual10 = intAccrual10 + i
Case 11 'November
intAccrual11 = intAccrual11 + i
Case 12 'December
intAccrual12 = intAccrual12 + i
End Select
Next
End Sub
|