Attribute VB_Name = "cnv_DateStringLongConv"
Option Explicit
Option Base 0

' yyyy-mm-dd
Public Function DateStringToLong(Optional ByVal DateString As String) As Long
Dim xGreg As Long
Dim xYear As Long
Dim xMonth As Long
Dim xDay As Long

If DateString = "" Then
  DateString = Date$
  xYear = Val(Right(DateString, 4&))
  xMonth = Val(Left(DateString, 2&))
  xDay = Val(Mid(DateString, 4&, 2&))
  Else
  xYear = Val(Left(DateString, 4&))
  xMonth = Val(Mid(DateString, 6&, 2&))
  xDay = Val(Right(DateString, 2&))
  End If

If Not xYear \ 400& = 0& Then xGreg = 1&
If Not (xYear Mod 400&) \ 100& = 0& Then xGreg = 0&
If Not (xYear Mod 100&) \ 4& = 0& Then xGreg = 1&
If Not xYear Mod 4& = 0& Then xGreg = 0&

xYear = xYear - 1&
DateStringToLong = (xYear \ 400&) * 146097
xYear = xYear Mod 400&
DateStringToLong = DateStringToLong + (xYear \ 100) * 36524
xYear = xYear Mod 100&
DateStringToLong = DateStringToLong + (xYear \ 4&) * 1461&
xYear = xYear Mod 4&
DateStringToLong = DateStringToLong + xYear * 365&

'Stop
Select Case xMonth
  Case 1&: xGreg = 0&
  Case 2&: DateStringToLong = DateStringToLong + 31: xGreg = 0&
  Case 3&: DateStringToLong = DateStringToLong + 59&
  Case 4&: DateStringToLong = DateStringToLong + 90&
  Case 5&: DateStringToLong = DateStringToLong + 120&
  Case 6&: DateStringToLong = DateStringToLong + 151&
  Case 7&: DateStringToLong = DateStringToLong + 181&
  Case 8&: DateStringToLong = DateStringToLong + 212&
  Case 9&: DateStringToLong = DateStringToLong + 243&
  Case 10&: DateStringToLong = DateStringToLong + 273&
  Case 11&: DateStringToLong = DateStringToLong + 304&
  Case 12&: DateStringToLong = DateStringToLong + 334&
  End Select

DateStringToLong = DateStringToLong + xGreg + xDay
End Function

Public Function LongToDateString(ByVal DateID As Long) As String
Dim xYear As Long
Dim xMonth As Long
Dim xDay As Long
Dim xGreg As Long
Dim xLong1 As Long
Dim xChar1 As String

DateID = DateID - 1&
xYear = (DateID \ 146097) * 400&
DateID = DateID Mod 146097
xLong1 = DateID \ 36524
If xLong1 = 4& Then xLong1 = 3&
xYear = xYear + xLong1 * 100&
DateID = DateID - xLong1 * 36524
xYear = xYear + (DateID \ 1461&) * 4&
DateID = DateID Mod 1461&
xLong1 = (DateID \ 365&)
If xLong1 = 4& Then xLong1 = 3&
xYear = xYear + xLong1
DateID = DateID - xLong1 * 365& + 1&
xYear = xYear + 1&

'Stop

If Not xYear \ 400& = 0& Then xGreg = 1
If Not (xYear Mod 400&) \ 100& = 0& Then xGreg = 0&
If Not (xYear Mod 100&) \ 4& = 0& Then xGreg = 1&
If Not xYear Mod 4 = 0& Then xGreg = 0&

Select Case DateID
  Case 1& To 31&: xMonth = 1& 'xDay = DateID
  Case 32& To 59& + xGreg: xMonth = 2&: xDay = DateID - 31&
  Case 60& + xGreg To 90& + xGreg: xMonth = 3&: xDay = DateID - 59& - xGreg
  Case 91& + xGreg To 120& + xGreg: xMonth = 4&: xDay = DateID - 90& - xGreg
  Case 121& + xGreg To 151& + xGreg: xMonth = 5&: xDay = DateID - 120& - xGreg
  Case 152& + xGreg To 181& + xGreg: xMonth = 6&: xDay = DateID - 151& - xGreg
  Case 182& + xGreg To 212& + xGreg: xMonth = 7&: xDay = DateID - 181& - xGreg
  Case 213& + xGreg To 243& + xGreg: xMonth = 8&: xDay = DateID - 212& - xGreg
  Case 244& + xGreg To 273& + xGreg: xMonth = 9&: xDay = DateID - 243& - xGreg
  Case 274& + xGreg To 304& + xGreg: xMonth = 10&: xDay = DateID - 273& - xGreg
  Case 305& + xGreg To 334& + xGreg: xMonth = 11&: xDay = DateID - 304& - xGreg
  Case 335& + xGreg To 365& + xGreg: xMonth = 12&: xDay = DateID - 334& - xGreg
  End Select

LongToDateString = Right("0000" & Trim(Str(xYear)), 4&) & _
                   "-" & _
                   Right("00" & Trim(Str(xMonth)), 2&) & _
                   "-" & _
                   Right("00" & Trim(Str(xDay)), 2&)
End Function

