by Craig Parsons (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 1st June 2000
Date Added: Mon 8th February 2021
Rating:
(1 Votes)
Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date.
API Declarations
' * Programmer Name: Craig Parsons
' * E-Mail: [email protected]
' * Date: 01-06-2000
' * Module Name: JulianConvert
' * Module Filename: JulianConvert.bas
' * Examples()
' *
' * Returns a NULL Value on Error
' *
' '-- Current Date in Julian Short Format
' MsgBox GetJulianFromDate()
' '-- Current Date in Julian Short Format
' MsgBox GetJulianFromDate(, Short_Julian)
' '-- Xmas Date in Julian Short Format
' MsgBox GetJulianFromDate("12/25/1999")
' '-- Xmas Date in Julian Short Format
' MsgBox GetJulianFromDate("12/25/1999", Short_Julian)
' '-- Current Date in Julian Long Format
' MsgBox GetJulianFromDate(, Long_Julian)
' '-- Xmas Date in Julian Long Format
' MsgBox GetJulianFromDate("12/25/1999", Long_Julian)
'
' MsgBox GetDateFromJulian("99359")
' MsgBox GetDateFromJulian("1999359")
' *
Option Explicit
Enum JulianFormat
Short_Julian
Long_Julian
End Enum
Dim sDy As String
Dim sMth As String
Dim sYr As String
Dim dDateVal As Date
'-- Set Error Handler
On Error GoTo GetDateFromJulianERR
'-- Get Month Value from Julian Date Parm.
sMth = Format(Right$(JulianVal, 3), "mm")
'-- Get Day Value from Julian Parm.
sDy = Format(Right$(Val(JulianVal + 1), 3), "dd")
'-- Check Julian Val passed in
'
'-- If Length of Parm. is 5 Then Short Julian Date Passed in ( YYDDD )
'-- ELSE
'-- If Length of Parm. is 7 then Long Julian date passed in ( YYYYDDD )
'-- If Len = 5 then Short Julian
If Len(JulianVal) = 5 Then
'-- Strip Two Digit Year from Parm.
sYr = Left$(JulianVal, 2)
'-- Set Date variable = to Current Gregorian format
dDateVal = CDate(sMth & "/" & sDy & "/" & sYr)
'-- Set Function = to Gregorian Date Value
GetDateFromJulian = dDateVal
Exit Function
'-- If Len = 7 then Long Julian
ElseIf Len(JulianVal) = 7 Then
'-- Strip Four Digit Year
sYr = Left$(JulianVal, 4)
'-- Set Date variable = to Current Gregorian format
dDateVal = CDate(sMth & "/" & sDy & "/" & sYr)
'-- Set Function = to Gregorian Date Value
GetDateFromJulian = dDateVal
Exit Function
Else
'-- Error Out Set RETURN to NULL
GoTo GetDateFromJulianERR
End If
Exit Function
GetDateFromJulianERR:
GetDateFromJulian = Null
End Function
Function GetJulianFromDate(Optional ByVal DateVal As String = vbNullString, Optional ByVal JulianType As JulianFormat = 0) As Variant
Dim sDy As String
Dim sYr As String
Dim sJulianVal As String
'-- Set Error Handler
On Error GoTo GetJulianFromDateERR
'-- Check If Null Then Get Current Date
If DateVal = vbNullString Then
DateVal = Format(Date, "mm/dd/yyyy")
'-- If not Null Date was Passed In
Else
'-- Validate The Parm is a Date Value
If IsDate(DateVal) Then
'-- If Date Value then Format it
DateVal = Format(DateVal, "mm/dd/yyyy")
Else
'-- Parm. passed in is an In-Valid Date
GoTo GetJulianFromDateERR
End If
End If
'-- Strip Days
sDy = Format(DateVal, "y")
'-- Format Days to use a 3 Digit Variable
sDy = Format(Val(sDy), "00#")
'-- If Julian type option is Short
If JulianType = Short_Julian Then
'-- Strip Two Digit Year from Date Parm.
sYr = Format(DateVal, "yy")
'-- Set Variable = to New 5 Digit JULIAN Value
sJulianVal = sYr & sDy
'-- Set Function = Julian Date Value
GetJulianFromDate = sJulianVal
Exit Function
'-- If Julian type option is Long
ElseIf JulianType = Long_Julian Then
'-- Strip Four Digit Year
sYr = Format(DateVal, "yyyy")
'-- Set Variable = to New 7 Digit JULIAN Value
sJulianVal = sYr & sDy
'-- Set Function = Julian Date Value
GetJulianFromDate = sJulianVal
Exit Function
Else
'-- Error Out Set RETURN to NULL
GoTo GetJulianFromDateERR
End If
Exit Function
GetJulianFromDateERR:
GetJulianFromDate = Null
End Function
No comments have been posted about Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date.. Why not be the first to post a comment about Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date..