Function MyDays(myYear As Integer, pWday As Integer)
'*************************************************
'Name: MyDays (Function)
'Purpose: Create tblTimesheet and populate
' it with Start and EndDates for
' specified year
'Parameters: myYear = year, e.g. 2001
' pWday = Day of week that workweek
' ends, e.g. 1 = Sunday, 7 = Saturday
'Inputs: from debug window (Ctrl-G):
' ? MyDays(2002, 7) <enter>
'Output: tblTimesheet with all work periods
' for specified year
'*************************************************
Dim db As DATABASE, rs As Recordset
Dim datehold As Date
Dim tName As String, test As String, strSQL As String
Set db = CurrentDb
tName = "tblTimesheet"
'Does table exist? If true, delete it;
On Error Resume Next
test = db.TableDefs(tName).Name
If Err <> 3265 Then
docmd.DeleteObject acTable, tName
End If
'Create new tblTimesheet
strSQL = "CREATE TABLE " & tName & " (StartDate Datetime, Enddate Datetime," _
& " RegHrs single, OTHrs single, HolHrs single);"
db.Execute strSQL
'Populate table
Set rs = db.OpenRecordset(tName)
'first day of year
datehold = DateSerial(myYear, 1, 1)
'determine first specified day of month, e.g. Sunday = 1, Tuesday = 3, etc.
datehold = datehold - WeekDay(datehold) + pWday + IIf(WeekDay(datehold) > pWday, 7, 0)
'loop thru the year
Do While Year(datehold) = myYear
With rs
.AddNew
!StartDate = datehold - 6
!enddate = datehold
.Update
End With
datehold = DateAdd("d", 7, datehold)
If Year(datehold) > myYear Then Exit Do
Loop
'cleanup
rs.Close
db.Close
Set db = Nothing
Beep
MsgBox ("That's all, folks!")
End Function