• Home
 · 
• Miscellaneous
 · 
• Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date.

Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date.

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



Rate Convert Julian Dates to Standard Gregorian Format. Get Julian Date Value From Standard Date.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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