Date function

Jeanette

Registered User.
Local time
Today, 12:19
Joined
Dec 17, 2001
Messages
52
How can I use one of the date functions to return the date for every saturday in a year. I have a timesheet report and the weekending date should always end on a saturday. Thanks in advance.
 
Here's an example you can try.
Copy/paste the following to a new module then,
from the debug window, type ? MyDays(2002, 7) <enter>
Code:
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
 

Users who are viewing this thread

Back
Top Bottom