Julian Date Code

‘*****************************************************************
‘* Function Name : sJulianDate *
‘* Created By : Thomas A. Cassano *
‘* date : 00/00/97 *
‘* Purpose : *
‘* Arguments : *
‘* Returns : string *
‘* Comments : None *
‘*****************************************************************

public Function sJulianDate(byval dCompare_date as date, _
sEditMask as string) as string

on error GoTo sJulianDateErr

Dim sErr_Msg as string

‘*** set pointer
Select Case UCase(sEditMask)
Case "CCYYDDD"
sJulianDate = Format$(dCompare_date, "yyyy") & _
sStrZero(Format$(dCompare_date, "y"), 3)
Case "YYDDD"
sJulianDate = Format$(dCompare_date, "yy") & _
sStrZero(Format$(dCompare_date, "y"), 3)
Case else
sJulianDate = sStrZero(Format$(dCompare_date, "y"), 3)
End Select

Exit Function

sJulianDateErr:
‘*** trapped the error, handle it…

sJulianDate = null

‘*** error reset pointer
Screen.MousePointer = vbDefault

‘absolute failure
sErr_Msg = sErr_Msg & "error in function sJulianDate…" & _
vbCrLf
sErr_Msg = sErr_Msg & "error # [" & LTrim(Str(Err.Number)) & _
"] " & Err.Description & vbCrLf
sErr_Msg = sErr_Msg & gsSTD_ERR_MSG

MsgBox sErr_Msg, vbExclamation & vbOKOnly, gsSTD_WIN_TITLE

End Function

More by Author

Must Read