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