DateNum

If lngMonth = 2 Then
     If Not (lngYear Mod 4 = 0) And (lngYear Mod 100 = 0) _
        And (lngYear Mod 400 = 0) Then 'not a leap year
        dateToNumber = -1
           Exit Function 'Abnormal termination
     End If
  End If

For intMonthCount = LBound(arrMonthDayMax) To lngMonth - 1
      intTMP = intTMP + arrMonthDayMax(intMonthCount)
  Next intMonthCount
  
  dateToNumber = (lngYear * 1000) + intTMP + lngDay
  Exit Function
    
  errorHandling:
  Call Err.Raise(Err.Number, Err.Source, Err.Description)
End Function

Public Function dateToNumber(ByVal prmdatToConvert As Date) As Long
On Error Goto errorHandling
Dim lngYear As Long
Dim lngMonth As Long
Dim lngDay As Long
Dim arrMonthDayMax As Variant
Dim intMonthCount As Integer
Dim intTMP As Integer
arrMonthDayMax = Array(31, 99, 31, 30, 31, 30, 31, 31, 30, _
31, 30, 31)
lngYear = CLng(Format(prmdatToConvert, "YYYY"))
lngMonth = CLng(Format(prmdatToConvert, "MM"))
lngDay = CLng(Format(prmdatToConvert, "DD"))

If lngMonth = 2 Then
If Not (lngYear Mod 4 = 0) And (lngYear Mod 100 = 0) _
And (lngYear Mod 400 = 0) Then 'not a leap year
dateToNumber = -1
Exit Function 'Abnormal termination
End If
End If

For intMonthCount = LBound(arrMonthDayMax) To lngMonth - 1
intTMP = intTMP + arrMonthDayMax(intMonthCount)
Next intMonthCount

dateToNumber = (lngYear * 1000) + intTMP + lngDay
Exit Function

errorHandling:
Call Err.Raise(Err.Number, Err.Source, Err.Description)
End Function