Attribute VB_Name = "modDateWords"
Option Compare Database
Option Explicit

Public Enum DateFormat
  USA = 1
  Europe = 2
End Enum

Public Function DateToWords(datDate As Date, Optional intFormat As DateFormat = 1) As String
Dim strReturn As String, intI As Integer, intYear As Integer
Dim intMonth As Integer, intDay As Integer, intCentury As Integer
Dim strMonth As String, strYear As String, strDay As String
Dim strDayNames(1 To 31) As String

    ' Initialize the day names
    strDayNames(1) = "First"
    strDayNames(2) = "Second"
    strDayNames(3) = "Third"
    strDayNames(4) = "Fourth"
    strDayNames(5) = "Fifth"
    strDayNames(6) = "Sixth"
    strDayNames(7) = "Seventh"
    strDayNames(8) = "Eighth"
    strDayNames(9) = "Ninth"
    strDayNames(10) = "Tenth"
    strDayNames(11) = "Eleventh"
    strDayNames(12) = "Twelfth"
    strDayNames(13) = "Thirteenth"
    strDayNames(14) = "Fourteenth"
    strDayNames(15) = "Fifteenth"
    strDayNames(16) = "Sixteenth"
    strDayNames(17) = "Seventeenth"
    strDayNames(18) = "Eighteenth"
    strDayNames(19) = "Nineteenth"
    strDayNames(20) = "Twentieth"
    strDayNames(21) = "Twenty First"
    strDayNames(22) = "Twenty Second"
    strDayNames(23) = "Twenty Third"
    strDayNames(24) = "Twenty Fourth"
    strDayNames(25) = "Twenty Fifth"
    strDayNames(26) = "Twenty Sixth"
    strDayNames(27) = "Twenty Seventh"
    strDayNames(28) = "Twenty Eighth"
    strDayNames(29) = "Twenty Ninth"
    strDayNames(30) = "Thirtieth"
    strDayNames(31) = "Thirty First"
    
    ' Pull apart the date
    intYear = Year(datDate)
    intMonth = Month(datDate)
    intDay = Day(datDate)
    intCentury = intYear \ 100
    intYear = intYear Mod 100
    
    ' Get the month name
    strMonth = Format(datDate, "mmmm")
    
    ' Get the day name
    strDay = strDayNames(intDay)
    
    ' Figure out the year name
    ' Special case for 2000
    If intCentury = 20 Then
        strYear = "Two Thousand " & NumberToWords(intYear)
    Else
        strYear = NumberToWords(intCentury) & " " & NumberToWords(intYear)
    End If
    
    ' Return the answer based on format requested
    If intFormat = Europe Then
        strReturn = strDay & " " & strMonth & " " & strYear
    Else
        strReturn = strMonth & " " & strDay & " " & strYear
    End If
    ' Return the Answer
    DateToWords = strReturn
    

End Function

Public Function NumberToWords(intNumber As Integer) As String
Dim intTen As Integer, intOne As Integer, strReturn As String
    ' Bail if > 99
    If intNumber > 99 Then Exit Function
    ' Break it up into tens and ones
    intTen = (intNumber \ 10) * 10
    intOne = intNumber Mod 10
    ' If greater than 19
    If (intNumber > 19) And (intNumber Mod 10 <> 0) Then
        ' Return names for ten and one values
        ' If the "one" digit is zero
        If intOne = 0 Then
            ' Get just the "tens" name
            strReturn = NumberToWords(intTen)
        Else
            ' Get both names
            strReturn = NumberToWords(intTen) & " " & NumberToWords(intOne)
        End If
    Else
        ' Special case for one through 19 and even 10s
        Select Case intNumber
            Case 1
                strReturn = "One"
            Case 2
                strReturn = "Two"
            Case 3
                strReturn = "Three"
            Case 4
                strReturn = "Four"
            Case 5
                strReturn = "Five"
            Case 6
                strReturn = "Six"
            Case 7
                strReturn = "Seven"
            Case 8
                strReturn = "Eight"
            Case 9
                strReturn = "Nine"
            Case 10
                strReturn = "Ten"
            Case 11
                strReturn = "Eleven"
            Case 12
                strReturn = "Twelve"
            Case 13
                strReturn = "Thirteen"
            Case 14
                strReturn = "Fourteen"
            Case 15
                strReturn = "Fifteen"
            Case 16
                strReturn = "Sixteen"
            Case 17
                strReturn = "Seventeen"
            Case 18
                strReturn = "Eighteen"
            Case 19
                strReturn = "Nineteen"
            Case 20
                strReturn = "Twenty"
            Case 30
                strReturn = "Thirty"
            Case 40
                strReturn = "Forty"
            Case 50
                strReturn = "Fifty"
            Case 60
                strReturn = "Sixty"
            Case 70
                strReturn = "Seventy"
            Case 80
                strReturn = "Eighty"
            Case 90
                strReturn = "Ninety"
        End Select
    End If
    ' Return the answer
    NumberToWords = strReturn
    
End Function