[AccessD] Closure on the String to Date topic

Arthur Fuller fuller.artful at gmail.com
Mon Nov 26 22:10:42 CST 2012


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>

-- 
Arthur
Cell: 647.710.1314

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


More information about the AccessD mailing list