Function FormatMyDate( strDate, strFormat )
' Accepts strDate as a valid date/time,
' strFormat as the output template.
' The function finds each item in the template and replaces it with the relevant information extracted from strDate
' Template items (example)
' %m Month as a decimal (2)
' %M Month as a decimal (02)
' %B Full month name (February)
' %b Abbreviated month name (Feb )
' %d Day of the month (9)
' %D Day of the month (09)
' %O Ordinal of day of month (eg st or rd or nd)
' %j Day of the year (54)
' %Y Year with century (1998)
' %y Year without century (98)
' %w Weekday as integer (0 is Sunday)
' %a Abbreviated day name (Fri)
' %A Weekday Name (Friday)
' %H Hour in 24 hour format (24)
' %h Hour in 12 hour format (12)
' %N Minute as an integer (01)
' %n Minute as optional if minute <> 0
' %S Second as an integer (55)
' %P AM/PM Indicator (PM)
On Error Resume Next
Dim intPosItem
Dim int12HourPart
Dim str24HourPart
Dim strMinutePart
Dim strSecondPart
Dim strAMPM
strFormat = Replace(strFormat, "%m", DatePart("m", strDate), 1, -1, vbBinaryCompare) ' Month Numbers
strFormat = Replace(strFormat, "%M", Right("00" & DatePart("m", strDate),2), 1, -1, vbBinaryCompare) ' Month Numbers with leading zeros
strFormat = Replace(strFormat, "%B", MonthName(DatePart("m", strDate), False), 1, -1, vbBinaryCompare) ' Non-Abbreviated Month Names
strFormat = Replace(strFormat, "%b", MonthName(DatePart("m", strDate), True), 1, -1, vbBinaryCompare) ' Abbreviated Month Names
strFormat = Replace(strFormat, "%d", DatePart("d",strDate), 1, -1, vbBinaryCompare) ' Day Of Month
strFormat = Replace(strFormat, "%D", Right("00" & DatePart("d",strDate),2), 1, -1, vbBinaryCompare) ' Day Of Month with leading zeros
strFormat = Replace(strFormat, "%O", fncGetDayOrdinal(Day(strDate)), 1, -1, vbBinaryCompare) ' Day of Month Ordinal (eg st, th, or rd)
strFormat = Replace(strFormat, "%j", DatePart("y",strDate), 1, -1, vbBinaryCompare) ' Day of Year (205)
strFormat = Replace(strFormat, "%Y", DatePart("yyyy",strDate), 1, -1, vbBinaryCompare) ' Long Year (4 digit)
strFormat = Replace(strFormat, "%y", Right(DatePart("yyyy",strDate),2), 1, -1, vbBinaryCompare) ' Short Year (2 digit)
strFormat = Replace(strFormat, "%w", DatePart("w",strDate,1), 1, -1, vbBinaryCompare) ' Weekday as Integer (eg 0 = Sunday)
strFormat = Replace(strFormat, "%a", WeekDayName(DatePart("w",strDate,1),True), 1, -1, vbBinaryCompare) ' Abbreviated Weekday Name (eg Sun)
strFormat = Replace(strFormat, "%A", WeekDayName(DatePart("w",strDate,1),False), 1, -1, vbBinaryCompare) ' Non-Abbreviated Weekday Name
str24HourPart = DatePart("h",strDate) ' Hour in 24hr format
If Len(str24HourPart) < 2 then str24HourPart = "0" & str24HourPart
strFormat = Replace(strFormat, "%H", str24HourPart, 1, -1, vbBinaryCompare)
int12HourPart = DatePart("h",strDate) Mod 12 ' Insert Hour in 12hr format
If int12HourPart = 0 then int12HourPart = 12
strFormat = Replace(strFormat, "%h", int12HourPart, 1, -1, vbBinaryCompare)
strMinutePart = DatePart("n",strDate) ' Insert Minutes
If Len(strMinutePart) < 2 then strMinutePart = "0" & strMinutePart
strFormat = Replace(strFormat, "%N", strMinutePart, 1, -1, vbBinaryCompare)
If CInt(strMinutePart) = 0 then ' Insert Optional Minutes
strFormat = Replace(strFormat, "%n", "", 1, -1, vbBinaryCompare)
Else
If CInt(strMinutePart) < 10 then strMinutePart = "0" & strMinutePart
strMinutePart = ":" & strMinutePart
strFormat = Replace(strFormat, "%n", strMinutePart, 1, -1, vbBinaryCompare)
End if
strSecondPart = DatePart("s",strDate) ' Insert Seconds
If Len(strSecondPart) < 2 then strSecondPart = "0" & strSecondPart
strFormat = Replace(strFormat, "%S", strSecondPart, 1, -1, vbBinaryCompare)
If DatePart("h",strDate) >= 12 then ' Insert AM/PM indicator
strAMPM = "PM"
Else
strAMPM = "AM"
End If
strFormat = Replace(strFormat, "%P", strAMPM, 1, -1, vbBinaryCompare)
FormatMyDate = strFormat
If err.Number <> 0 then ' If there is an error output its value
Response.Clear
Response.Write "ERROR " & err.Number & ": fmcFmtDate - " & err.Description
Response.Flush
Response.End
End if
End Function ' FormatMyDate
Function fncGetDayOrdinal(intDay)
' Accepts a day of the month as an integer and returns the appropriate suffix
Dim strOrd
Select Case intDay
Case 1, 21, 31
strOrd = "st"
Case 2, 22
strOrd = "nd"
Case 3, 23
strOrd = "rd"
Case Else
strOrd = "th"
End Select
fncGetDayOrdinal = strOrd
End Function ' fncGetDayOrdinal