FormatMyDate

Formats a date, equivalent to VB6 function 'Format'
Also with it, you will find 'fncGetDayOrdinal' to get the ordinal of day (1st, 2nd, 6th, etc.)

CodeFunctionName
What is this?

Public

Tested

Imported
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

strDate, strFormat
or
intDay

Views 2,993

Downloads 1,179

CodeID
DB ID