[AccessD] Closure on the String to Date topic

Arthur Fuller fuller.artful at gmail.com
Mon Nov 26 23:08:11 CST 2012


There we go. Thanks!


On Mon, Nov 26, 2012 at 11:27 PM, Stuart McLachlan
<stuart at lexacorp.com.pg>wrote:

> Alternative (simpler?)  functions:
>
> Public Function BoM(dt As Date) As Date
>     BoM = DateSerial(year(dt),month(dt),1)
> End Function
>
> Public Function BoY(dt As Date) As Date
>      BoY = DateSerial(year(dt),1,1)
>  End Function
>
> Public Function EoY(dt As Date) As Date
>      EoY = Dateserial(year(dt),12,31)
> End Function
>
> Public Function EoM(dt as date)
>   EOM =  DateSerial(year(dt),month(dt) +1,1) -1
> End Function
>
>
>
> On 26 Nov 2012 at 23:10, Arthur Fuller wrote:
>
> > Thanks to your suggestions, I got where I needed to go. In the course of
> > which I dug up and also created a few new functions, presented below.
> They
> > are a long way from rocket science, but someone might find them useful.
> > Also included are a couple of test procs, one to exercise all the
> variants
> > on DateAdd() and the other to exercise the new functions I've included.
> >
> > <vba>
> > '---------------------------------------------------------------
> > Public Sub TestDateAdd()
> >     Dim dt As Date
> >     dt = Now()
> >     Debug.Print "Initial Date: " & dt
> >     Debug.Print "Adding 1 year       : ", DateAdd("yyyy", 1, dt)
> >     Debug.Print "Subtracting 1 year  : ", DateAdd("y", -1, dt)
> >
> >     Debug.Print "Adding 1 month      : ", DateAdd("m", 1, dt)
> >     Debug.Print "Subtracting 1 month : ", DateAdd("m", -1, dt)
> >
> >     Debug.Print "Adding 1 week       : ", DateAdd("ww", 1, dt)
> >     Debug.Print "Subtracting 1 week  : ", DateAdd("ww", -1, dt)
> >
> >     Debug.Print "Adding 1 day        : ", DateAdd("d", 1, dt)
> >     Debug.Print "Subtracting 1 day   : ", DateAdd("d", -1, dt)
> >
> >     Debug.Print "Adding 1 hour       : ", DateAdd("h", 1, dt)
> >     Debug.Print "Subtracting 1 hour  : ", DateAdd("h", -1, dt)
> >
> >     Debug.Print "Adding 1 minute     : ", DateAdd("n", 1, dt)
> >     Debug.Print "Subtracting 1 minute: ", DateAdd("n", -1, dt)
> >
> >     Debug.Print "Adding 1 second     : ", DateAdd("s", 1, dt)
> >     Debug.Print "Subtracting 1 second: ", DateAdd("s", -1, dt)
> >
> > End Sub
> >
> > '---------------------------------------------------------------
> > Public Sub TestNewDateFuncs()
> >     Dim dt As Date
> >     dt = Now()
> >     Debug.Print "Initial Date: " & dt
> >     Debug.Print "Beg of Year : ", BoY(dt)
> >     Debug.Print "End of Year : ", EoY(dt)
> >
> >     Debug.Print "Beg of Month: ", BoM(dt)
> >     Debug.Print "End of Month: ", EoM(dt)
> >
> >     Debug.Print "Beg of Week (Default) : ", BoW(dt)
> >     Debug.Print "End of Week (Default) : ", EoW(dt)
> >
> >     Debug.Print "Beg of Week (Business): ", BoW(dt, True)
> >     Debug.Print "End of Week (Business): ", EoW(dt, True)
> >
> > End Sub
> > </vba>
> >
> > In a new module called DateFunctions...
> >
> > <vba>
> > '---------------------------------------------------------------
> > ' Name      : Date Functions
> > ' Author    : Arthur Fuller
> > ' Purpose   : A collection of date-handling functions
> > ' Notes:
> > '
> > '---------------------------------------------------------------
> > Option Compare Database
> > Option Explicit
> >
> > '---------------------------------------------------------------
> > ' Name: BoM()
> > ' Purpose: Returns the beginning of month for specified date
> > ' Notes:
> > '---------------------------------------------------------------
> > Public Function BoM(dt As Date) As Date
> >     BoM = dt - Day(dt) + 1
> > End Function
> >
> > '---------------------------------------------------------------
> > ' Name: EoM()
> > ' Purpose: Returns the end of month for specified date
> > ' Notes:
> > '---------------------------------------------------------------
> > Public Function EoM(dt As Date) As Date
> >     EoM = DateAdd("m", 1, BoM(dt)) - 1
> > End Function
> >
> > '---------------------------------------------------------------
> > ' Name: BoY()
> > ' Purpose: Returns the first date of the year for specified date
> > '---------------------------------------------------------------
> > Public Function BoY(dt As Date) As Date
> >     Dim iMonths As Integer
> >     iMonths = -(Month(dt) - 1)
> >     Debug.Print BoM(DateAdd("m", iMonths, Date)) 'DateAdd("m", 1,
> BoM(dt))
> > - 1
> >     BoY = BoM(DateAdd("m", iMonths, Date)) 'DateAdd("m", 1, BoM(dt)) - 1
> > '    BoY = BoM(DateAdd("m", -(Month(dt) - 1), Date)) 'DateAdd("m", 1,
> > BoM(dt)) - 1
> > End Function
> >
> > '---------------------------------------------------------------
> > ' Name: EoY()
> > ' Purpose: Returns the last date of the year for specified date
> > '---------------------------------------------------------------
> > Public Function EoY(dt As Date) As Date
> >     Dim iMonths As Integer
> >     iMonths = 12 - Month(dt)
> >     Dim dtTemp As Date
> >     dtTemp = DateAdd("m", iMonths, dt)
> >     EoY = EoM(DateAdd("m", 12 - Month(dt), Date)) 'DateAdd("m", 1,
> BoM(dt))
> > - 1
> > End Function
> >
> > '---------------------------------------------------------------
> > ' Name: BoW()
> > ' Purpose: Returns the first date of the week for specified date
> > ' Notes:
> > '   Some think the week begins on Sunday, others Monday
> > '   The default is Sunday; the optional parameter overtides this
> > '---------------------------------------------------------------
> > Public Function BoW(dt As Date, Optional bolOver As Boolean) As Date
> >     Dim dtTemp As Date
> >     Dim iDays As Integer
> >     iDays = -(Weekday(dt) - 1)
> >     dtTemp = DateAdd("d", iDays, Date)
> >     If bolOver = True Then dtTemp = dtTemp + 1
> >     BoW = dtTemp
> > End Function
> >
> > '---------------------------------------------------------------
> > ' Name: EoW()
> > ' Purpose: Returns the last date of the week for specified date
> > ' Notes:
> > '   Some think the week begins on Sunday, others Monday
> > '   The default is Sunday; the optional parameter overtides this
> > '---------------------------------------------------------------
> > Public Function EoW(dt As Date, Optional bolOver As Boolean) As Date
> >     Dim dtTemp As Date
> >     dtTemp = DateAdd("d", 7 - Weekday(dt), dt)
> >     If bolOver = True Then dtTemp = dtTemp + 1
> >     EoW = dtTemp
> > End Function
> >
> > </vba>
> >
>
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>



-- 
Arthur
Cell: 647.710.1314

Prediction is difficult, especially of the future.
  -- Niels Bohr


More information about the AccessD mailing list