John W. Colby
jwcolby at colbyconsulting.com
Tue Jun 7 11:05:54 CDT 2005
Private Function dateStartRange(intRangeOption As Integer) As Date
On Error GoTo Err_dateStartRange
'Julie Schwalm, Backroads Data, 1999
'Input: interger value of option group containing standard date ranges,
'such as Current Month, Year-to-Date, Last Quarter, etc. Values equal:
' 1 = Include all Dates
' 2 = Current Month
' 3 = Current Quarter
' 4 = Current Year
' 5 = Month-to-Date
' 6 = Quarter-to-Date
' 7 = Year-to-Date
' 8 = Last Month
' 9 = Last Quarter
' 10 = Last Year
' 11 = Last 12 months
' 12 = Custom Date
'OUTPUT: Date to be placed in unbound text box, representing the beginning
'of the date range for the selected report.
Dim dateResult As Date
Select Case intRangeOption
Case 1 'Include all Dates
Let dateResult = #1/1/1900#
Case 2, 5 'Current Month
Let dateResult = DateSerial(Year(Date), Month(Date), 1)
Case 3, 6
Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 1, 1)
Case 4, 7
Let dateResult = DateSerial(Year(Date), 1, 1)
Case 8
Let dateResult = DateSerial(Year(Date), Month(Date) - 1, 1)
Case 9
Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 1 - 3, 1)
Case 10
Let dateResult = DateSerial(Year(Date) - 1, 1, 1)
Case 11
Let dateResult = DateAdd("yyyy", -1, Date) + 1
End Select
dateStartRange = Format(dateResult, "mm\/dd\/yyyy")
Exit_dateStartRange:
Exit Function
Err_dateStartRange:
Select Case Err
Case 0 '.insert Errors you wish to ignore here
Resume Next
Case Else '.All other errors will trap
Beep
MsgBox Err.Description, , "Error in Function
basDateFunctions.dateStartRange"
Resume Exit_dateStartRange
End Select
Resume 0 '.FOR TROUBLESHOOTING
End Function
Private Function dateEndRange(intRangeOption As Integer) As Date
On Error GoTo Err_dateEndRange
'Julie Schwalm, Backroads Data, 1999
'Input: interger value of option group containing standard date ranges,
'such as Current Month, Year-to-Date, Last Quarter, etc. Values equal:
' 1 = Include all Dates
' 2 = Current Month
' 3 = Current Quarter
' 4 = Current Year
' 5 = Month-to-Date
' 6 = Quarter-to-Date
' 7 = Year-to-Date
' 8 = Last Month
' 9 = Last Quarter
' 10 = Last Year
' 11 = Last 12 months
' 12 = Custom Date
'OUTPUT: Date to be placed in unbound text box, representing the end
'of the date range for the selected report.
Dim dateResult As Date
Dim strDate As Date
Select Case intRangeOption
Case 1
Let dateResult = #1/1/2115#
Case 2
Let dateResult = DateSerial(Year(Date), Month(Date) + 1, 0)
Case 3
Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 4, 0)
Case 4
Let dateResult = DateSerial(Year(Date), 12, 31)
Case 5, 6, 7, 11
Let dateResult = Date
Case 8
Let dateResult = DateSerial(Year(Date), Month(Date), 0)
Case 9
Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 4 - 3, 0)
Case 10
' Let dateResult = DateAdd("yyyy", -1, Date) + 1
Let dateResult = DateSerial(Year(Date) - 1, 12, 31)
End Select
dateEndRange = Format(dateResult, "mm\/dd\/yyyy")
Exit_dateEndRange:
Exit Function
Err_dateEndRange:
Select Case Err
Case 0 '.insert Errors you wish to ignore here
Resume Next
Case Else '.All other errors will trap
Beep
MsgBox Err.Description, , "Error in Function
basDateFunctions.dateEndRange"
Resume Exit_dateEndRange
End Select
Resume 0 '.FOR TROUBLESHOOTING
End Function
John W. Colby
www.ColbyConsulting.com
Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mark Boyd
Sent: Tuesday, June 07, 2005 11:49 AM
To: Access Developers discussion and problem solving
Subject: [AccessD] Dates From Previous Month
I'm looking for a way to get the 1st and last dates from the previous month.
I'm working on an invoicing app, and need to determine the previous months
date range. Is there a function, or use of the Format statement that will
give me this info?
Thanks,
Mark Boyd
I/S Supervisor
McBee Associates, Inc.
-----------------------------------------
This message and any attachments are intended only for the use of the
individual or entity to which it is addressed and may contain information
that is privileged, confidential, and exempt from disclosure under
applicable law. If the reader of this message is not the intended recipient,
or the employee or agent responsible for delivering the message to the
intended recipient, you are hereby notified that any dissemination,
distribution or copying of this communication is strictly prohibited. If you
have received this communication in error, please notify the sender by
replying to this message, and then delete it from your system.
-------------------------------------------
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com