Results 1 to 16 of 16

Thread: Dating problem!

  1. #1

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Dating problem!

    I want VB6 to interpret the dates it reads from file as DD/MM/YYYY, regardless of Regional setting. The reason is that I plug a stick memory in the available machine to run the program and don't want to worry about settings.
    What is the easiest way to do this?

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,929

    Re: Dating problem!

    You can split the string up and use the DateSerial function, as shown in the "How to safely convert a String to a Date" section of the article Why are my dates not working properly? from our Classic VB FAQs (in the FAQ forum)

  3. #3

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Re: Dating problem!

    Great, thanks!

  4. #4
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Dating problem!

    In case you want to avoid the explicit String-Splitting and use a more generic approach (per LCID-params),
    you can also take a look at this thread here, where the topic of such locale-aware conversions was
    recently discussed (with Code-Examples):

    http://www.vbforums.com/showthread.p...ta-Conversions

    Here both discussed functions in a version for a *.bas-Module (with two Public Functions ConvertLA and FormatLA).

    Code:
    Option Explicit
     
    'Locale-aware conversion-functions (as e.g. discussed here: www.vbforums.com/showthread.php?736407-VB6-VConvert-A-Class-for-Locale-Specific-Data-Conversions)
    'For more LCIDs you can look-up at: http://msdn.microsoft.com/de-de/goglobal/bb964664.aspx to make your pick
    Private Declare Function VariantChangeTypeEx Lib "oleaut32" (VDst As Variant, VSrc As Variant, ByVal LCID As Long, ByVal wFlags As Long, ByVal VT As Long) As Long
    Private Declare Function VarTokenizeFormatString Lib "oleaut32.dll" (ByVal pstrFormat As Long, rgbTok As Any, ByVal cbTok As Long, ByVal iFirstDay As Long, ByVal iFirstWeek As Long, ByVal LCID As Long, Optional ByVal pcbActual As Long) As Long
    Private Declare Function VarFormatFromTokens Lib "oleaut32.dll" (VIn As Variant, ByVal psFormat As Long, pbTokCur As Any, ByVal dwFlags As Long, ByVal psOut As Long, ByVal LCID As Long) As Long
     
    Public Function ConvertLA(Expression, ByVal ToType As VbVarType, Optional ByVal LCID As Long) As Variant
    Const VARIANT_ALPHABOOL As Long = &H2&, VARIANT_LOCALBOOL As Long = &H10&
    Static hRes As Long
     
      hRes = VariantChangeTypeEx(ConvertLA, Expression, LCID, VARIANT_ALPHABOOL Or VARIANT_LOCALBOOL, ToType)
      If hRes Then Err.Raise hRes
    End Function
    
    Public Function FormatLA(Expression, Optional Format As String, Optional ByVal FirstDayOfWeek As VbDayOfWeek = vbUseSystemDayOfWeek, Optional ByVal FirstWeekOfYear As VbFirstWeekOfYear = vbUseSystem, Optional ByVal TargetLCID As Long, Optional ByVal PatternLCID As Long = 1033) As String
    Static hRes As Long, B(0 To 4095) As Byte
    
      hRes = VarTokenizeFormatString(StrPtr(Format), B(0), UBound(B) + 1, FirstDayOfWeek, FirstWeekOfYear, PatternLCID)
      If hRes Then Err.Raise hRes
      
      hRes = VarFormatFromTokens(Expression, StrPtr(Format), B(0), 0, ByVal VarPtr(FormatLA), TargetLCID)
      If hRes Then Err.Raise hRes
    End Function

    Here some test-code to paste into a Form:

    Code:
    Option Explicit
    
    Private Sub Form_Click()
      AutoRedraw = True: Cls
      FontName = "Courier New"
      
      Const LCID_de = 1031, LCID_us = 1033, LCID_gb = 2057
    
      Dim S As String, D As Date
    
      'different date-input-strings, though the result should come out always the same (according to your system-locale)
      S = "01.12.1999": D = ConvertLA(S, vbDate, LCID_de): Print "with de-input '"; S; "' -> "; D
      S = "12/01/1999": D = ConvertLA(S, vbDate, LCID_us): Print "with us-input '"; S; "' -> "; D
      S = "01/12/1999": D = ConvertLA(S, vbDate, LCID_gb): Print "with gb-input '"; S; "' -> "; D
      
      'just a test with an input-string, which cannot be converted to a date
      On Error Resume Next
        D = ConvertLA("01/xy/99", vbDate, LCID_gb): Print "Err-Nr:"; Err.Number, Err.Description; vbCr
      On Error GoTo 0
      
      'finally some tests for the FormatLA-function, which converst from the same Date-Var to different locales
      Print FormatLA(D, "Short Date", , , LCID_de), FormatLA(D, "Long Date", , , LCID_de)
      Print FormatLA(D, "Short Date", , , LCID_us), FormatLA(D, "Long Date", , , LCID_us)
      Print FormatLA(D, "Short Date", , , LCID_gb), FormatLA(D, "Long Date", , , LCID_gb); vbCr
    End Sub
    ScreenShot of the Output (here on a german Win8, with default german locale-settings):



    Olaf

  5. #5
    PowerPoster SamOscarBrown's Avatar
    Join Date
    Aug 2012
    Location
    NC, USA
    Posts
    9,145

    Re: Dating problem!

    You outa get a lot of visits to this thread with a title like that one! :-)

  6. #6
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Dating problem!

    Quote Originally Posted by SamOscarBrown View Post
    You outa get a lot of visits to this thread with a title like that one! :-)
    ... yeah, also stumbled about it at the first glance

    Maybe unconsciously kept that in mind ("poor guy had no dates for a while") -
    and choose such an early example-date for this very reason - dunno -
    but maybe VBClassic-guys simply live in the past - at least that's what I'm told
    here by people who know things like that...

    hmm...

    But then there's also this german Error-Message "Typen unverträglich" ("Type mismatch") -
    WTH is going on here? ... "was she a german girl?" ... and why is this:
    "well, just incompatible types, you know..." message thrown at me
    with the Err-Number 13 for Gods sake?

    Mysterious things happening here, I tell ya...

    Olaf

  7. #7

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Re: Dating problem!

    Quote Originally Posted by SamOscarBrown View Post
    You outa get a lot of visits to this thread with a title like that one! :-)
    I hope it is not a freudian slip :-)

  8. #8

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Re: Dating problem!

    Turning back to the subject at hand!
    I changed the Calendar in WinXp to Hijri and rebooted.
    Typing in Immediate Window:
    ? Date: ? Date$
    I got:
    13/03/2013
    03-13-2013

    Interesting, isn't it?
    But the good news is that VB is not confused by other calendars.

  9. #9
    Fanatic Member
    Join Date
    Jan 2013
    Posts
    894

    Re: Dating problem!

    I uses internally, format$(datestring, "YYYY/MM/DD"), that way I can transmit internaly always the right information.

    Used when transmitting dates as strings.
    used when storing in a file dates.

    Only when it needs to show to the user, is converted to the regional if realy you wants.

  10. #10
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Dating problem!

    Quote Originally Posted by Bruin1953 View Post
    Turning back to the subject at hand!
    I changed the Calendar in WinXp to Hijri and rebooted.
    Typing in Immediate Window:
    ? Date: ? Date$
    I got:
    03-13-2014 03/13/2014 03/13/2014
    03-13-2013

    Interesting, isn't it?
    Indeed, wasn't aware that Date$ is producing an apparently locale-invariant result.
    Here on a german System I get for:
    Code:
    ? Date, Date$
    13.03.2014    03-13-2014
    The first result (13.03.2014) is clear how it's produced under the covers:
    (automatic type-coercion as in: ? CStr(Int(Now)) ... gives: -> 13.03.2014

    Though just checked with LCID = LOCALE_INVARIANT = 127 ...

    Code:
    ?Date$(), FormatLA(Now, "Short Date", , , 127), ConvertLA(Int(Now), vbString, 127)
    03-13-2014    03/13/2014    03/13/2014
    and it's producing a similar form (month, day, year) but with a different delimiter
    than Date$().

    Hmm - further testing shows, that the order (month, day, year) is never used
    in combination with the "-" delimiter as the Date$-function is producing:

    Testcode:
    Code:
    Private Sub Form_Load()
      Dim i As Long, S as String, CurDate As Date
    
      CurDate = Int(Now)
    
      On Error Resume Next
      For i = 0 To 70000 'just a rough, error-buffered loop over all LCID-candidates up to 70000
        S = ""
        S = ConvertLA(CurDate, vbString, i)
        If InStr(S, "-") Then Debug.Print i, S
      Next i
    
    End Sub
    Here the Output for the produced 87 occurences which contain "-" ... but as said, no "month-day-year" order among them:
    Code:
      6           13-03-2014
     18           2014-03-13
     19           13-3-2014
     21           2014-03-13
     23           13-03-2014
     29           2014-03-13
     39           2014-03-13
     53           13-03-2014
     56           13-03-2014
     57           13-03-2014
     63           13-???-14
     64           13-??? 14
     69           13-03-14
     70           13-03-14
     71           13-03-14
     72           13-03-14
     73           13-03-2014
     74           13-03-14
     75           13-03-14
     76           13-03-14
     77           13-03-2014
     78           13-03-2014
     79           13-03-2014
     80           2014-03-13
     83           2014-03-13
     87           13-03-2014
     91           2014-03-13
     95           13-03-2014
     98           13-3-2014
     111          13-03-2014
     122          13-03-2014
     128          2014-3-13
     1030         13-03-2014
     1042         2014-03-13
     1043         13-3-2014
     1045         2014-03-13
     1047         13-03-2014
     1053         2014-03-13
     1063         2014-03-13
     1077         13-03-2014
     1080         13-03-2014
     1081         13-03-2014
     1087         13-???-14
     1088         13-??? 14
     1093         13-03-14
     1094         13-03-14
     1095         13-03-14
     1096         13-03-14
     1097         13-03-2014
     1098         13-03-14
     1099         13-03-14
     1100         13-03-14
     1101         13-03-2014
     1102         13-03-2014
     1103         13-03-2014
     1104         2014-03-13
     1107         2014-03-13
     1111         13-03-2014
     1115         2014-03-13
     1122         13-3-2014
     1135         13-03-2014
     1146         13-03-2014
     1152         2014-3-13
     2060         13-03-14
     2107         2014-03-13
     2117         13-03-14
     2118         13-03-14
     2121         13-03-2014
     2143         13-03-2014
     3084         2014-03-13
     4105         2014-03-13
     4191         13-03-2014
     5121         13-03-2014
     5179         2014-03-13
     6145         13-03-2014
     7169         13-03-2014
     7177         2014-03-13
     7227         2014-03-13
     8202         13-03-2014
     13322        13-03-2014
     16393        13-03-2014
     30779        2014-03-13
     30800        2014-03-13
     30815        13-03-2014
     31803        2014-03-13
     31814        13-03-14
     31839        13-03-2014
    As you said, interesting that - perhaps a self-formatted local-invariant output of the VB-runtime then.

    Olaf
    Last edited by Schmidt; Mar 13th, 2014 at 03:19 PM.

  11. #11
    Fanatic Member
    Join Date
    Jan 2013
    Posts
    894

    Re: Dating problem!

    every beginner, soon or later falls in account that DATE$ (old school function) is useless, because it can spit useless data, like confusing then DD/MM/YYYY (ARG) by MM/DD/YYYY (USA).

    so for expressing a date in string format, the correct way is Format(datevar, "YYYY/MM/DD") that IIRC is the japanese format, and is no way that then a CDATE(string) reads it wrong.

    Another ODD (IIRC, I have not it that fresh in my mind) I found about "Date" data format, is that It can't store negative dates/values. When we needs a negative range?

    when doing DateResult = Date1 - Date2

    if DateResult>0 then ' Date1 is bigger.

    The valency that "one day" = "one integer". And hours + minutes + seconds is fraction part. It is great to do some calculations that it can do without casting of any kind.

    Date1 = 0

    Date1 = 50& whatever.

    but Date1 can't hold negative (again IIRC).

    I remember I have the needs to calculate date/time difference for adjusting the client reported LOCAL TIME (affected by its UTC) to see if it matches the client expected time according its license, and if not, sent a warning about a wrong time zone or RTC or just refuse to activate the service.

    Well, for countries in -UTC area, it has in the descriptor something like -03:00:00 , so the servers reads the global time, plus the customer utc expected it will give the customer's local.

    But was impossible that a Date store STORES a negative date, as result of CDATE("-03:00:00"), so I needed to create another field in the record to store if it is negative or positive, then to use custom code to PLUS or Substract. Maybe I am wrong, maybe not.

  12. #12

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Re: Dating problem!

    Thanks guys. Best VB forum in the world!

  13. #13
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: Dating problem!

    Quote Originally Posted by flyguille View Post
    ...for expressing a date in string format, the correct way is Format(datevar, "YYYY/MM/DD") that IIRC is the japanese format, and is no way that then a CDATE(string) reads it wrong.
    Well, why not go all the way - do it properly - and use the official ISO-Date?
    http://xkcd.com/1179/
    http://en.wikipedia.org/wiki/ISO_8601

    VBs CDate-Function has no problems when fed with Strings, formatted in ISO-8601-Standard.
    Has the advantage, that you can then refer to what you're using under a proper name,
    instead of speculating about, if it's "perhaps Japanese" ...

    Quote Originally Posted by flyguille View Post
    Another ODD (IIRC, I have not it that fresh in my mind) I found about "Date" data format, is that It can't store negative dates/values. When we needs a negative range?

    when doing DateResult = Date1 - Date2
    if DateResult>0 then ' Date1 is bigger.
    The valency that "one day" = "one integer". And hours + minutes + seconds is fraction part. It is great to do some calculations that it can do without casting of any kind.

    Date1 = 0
    Date1 = 50& whatever.
    but Date1 can't hold negative (again IIRC).
    Sorry, but that's wrongly speculated - why not test this stuff before posting.

    Code:
    Private Sub Form_Load()
    'DateVars store negative Values just fine (they are Doubles underneath)
    Dim D As Date: D = -1
    
    'so, calculations in "Date-Space" work just like any other math
    Debug.Print CDbl(D), "Today: "; Date, "Yesterday: "; Date + D
    End Sub
    Quote Originally Posted by flyguille View Post
    I remember I have the needs to calculate date/time difference for adjusting the client reported LOCAL TIME (affected by its UTC) to see if it matches the client expected time according its license, and if not, sent a warning about a wrong time zone or RTC or just refuse to activate the service.

    Well, for countries in -UTC area, it has in the descriptor something like -03:00:00 , so the servers reads the global time, plus the customer utc expected it will give the customer's local.

    But was impossible that a Date store STORES a negative date, as result of CDATE("-03:00:00"), so I needed to create another field in the record to store if it is negative or positive, then to use custom code to PLUS or Substract. Maybe I am wrong, maybe not.
    As said, when you talk about "Date Store" (and mean native VB-Date-Variables), those can keep negative Values just fine.
    Also the native Date-Fields in JET-DB-Tables (or other DBEngines) can take up such negative VB-Date-Values -
    and when you read them out per ADO-Rs, you'll see a perfectly fine VB-Date-delivery as well
    (their negative values not destroyed in such a "DB-Upload/DB-Retrieval - RoundTrip").

    So "Mem-Storage" and "DB-Storage" both work fine for negative values, and
    as already shown above, the math-calculations with VB-DateVars work directly as they should.

    As for your special problems with hh:mm:ss Time-Strings ...

    When those Strings are prefixed with either a "-" or a "+", then the CDate-Function will not eat them.
    CDate("03:00:00") works but neither does CDate("+03:00:00") nor CDate("-03:00:00")

    So, for that (respecting leading minus- or plus-chars) you will have to come up with your own StringToTime-function...

    Same thing for the opposite direction ... good Idea to write your own TimeToString-Function, ...
    Neither CStr(NegativeDateVar) nor Str(NegativeDateVar) nor FormatDateTime(NegativeDateVar, vbLongTime)
    support a negative TimeValue (the negative fraction of a Double). They always spit out a TimeString without
    the leading Minus-Sign.

    But that's String-Conversion-Stuff only. Native-Typed DateStorage works, as well as Native-Typed DateMath.

    Below is a more comprehensive example which demonstrates per code the things I've just mentioned:

    'Into a Form (Project will need a reference to ADO, and a small JET-DB is created dynamically in your Temp-Folder)
    Code:
    Option Explicit
    
    Private Sub Form_Load()
      TestDeltaDates
    End Sub
    
    Function TestDeltaDates()
    Dim FileName As String, Rs As Recordset, D As Date
        FileName = Environ("Temp") & "\testdates.mdb"
        
        CreateDB FileName, True
        OpenConn FileName
        
        Cnn.Execute "Create Table T(ID AutoIncrement, Delta Time)"
        
        'add 3 new DeltaTime-Records, fed over VBs Date-Type (containing Time-Values)
        Set Rs = GetRs("Select * From T Where 1=0")
               Rs.AddNew "Delta", StrToTime("-03:00:00")
               Rs.AddNew "Delta", StrToTime("+03:00:00")
               Rs.AddNew "Delta", StrToTime(" 00:00:00")
            Rs.UpdateBatch
     
        '----- now the read-out -----------
        D = CDate("2013-03-13 13:00:00") '<- VBs CDate() works flawlessly with ISO-8601-DateStrings
        
        Debug.Print "Rs-contained Deltas are added to the BaseDate below:"; vbCr; "BaseDate:", D, vbCr
        
        With GetRs("Select * From T")
          Do Until .EOF
            Debug.Print "FldType="; TypeName(!Delta.Value), TimeToStr(!Delta), D + !Delta
            .MoveNext
          Loop
        End With
        
        CloseConn
    End Function
    
    'the 2 one-liners below were just for fun (they work, but perhaps not with the best performance)
    Function StrToTime(S As String) As Date
      StrToTime = IIf(Val(S) < 0, -1, 1) * CDate(Replace(Replace(S, "+", 0), "-", 0))
    End Function
     
    Function TimeToStr(ByVal D As Date) As String
      TimeToStr = Choose(Sgn(D) + 2, "-", " ", "+") & D
    End Function

    'Some DBHelper-Functions for the above Form... into a *.bas-Module
    Code:
    Option Explicit
     
    Public Cnn As ADODB.Connection
     
    Public Sub CreateDB(mdbFileName As String, Optional ByVal OverwriteExisting As Boolean)
      If OverwriteExisting Then
        On Error Resume Next: Kill mdbFileName: On Error GoTo 0
      End If
      CreateObject("ADOX.Catalog").Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFileName
    End Sub
    
    Public Sub CloseConn()
      If Cnn Is Nothing Then Set Cnn = New ADODB.Connection
      If Not Cnn.State = adStateClosed Then Cnn.Close
    End Sub
    
    Public Sub OpenConn(mdbFileName As String)
      CloseConn 'since Cnn is a public Var (and DB-Files might change), we always try to close it first
      
      'since we ensured above, that Cnn is "closed and clean" we can change to a potentially different DB-File now...
      Cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFileName
      Cnn.CursorLocation = adUseClient
      Cnn.Open
    End Sub
    
    Public Function GetRs(Query As String) As ADODB.Recordset
      Set GetRs = New ADODB.Recordset
      GetRs.Open Query, Cnn, adOpenStatic, adLockOptimistic
    End Function
    Olaf

  14. #14

    Thread Starter
    Member
    Join Date
    Jan 2014
    Posts
    42

    Re: Dating problem!

    Having learned a lot from this discussion, a simple parsing function is all I need!

    ' Convert String to Serial Date
    Function DS(ByVal sDate As String, Optional sOrder As String = "DD/MM/YYYY") As Date
    ' Slashes are optional, but you must pass all 8 digits (31122012) if you delete them.
    ' Dashes (DD-MM-YYYY) will be changed to slashes, so you can pass either one.
    ' 1/1/2014 is Ok; leading zeros will be added.
    ' A slash in 4th position (2014/0228) = YYYYMMDD; sOrder will be ignored.
    ' Length of sDate must be either 8 (no slashes), 9 (one slash), or 10 (two slashes).
    Dim DD As String, MM As String, YYYY As String

    ' Format string (dashes, slashes, Leading zeros, 2-digit year).
    sDate = Replace(sDate, "-", "/")
    If Left$(sDate, 5) Like "####/" Then sOrder = "YYYY/MM/DD"
    If Left$(sDate, 2) Like "#/" Then sDate = "0" & sDate
    If Left$(sDate, 5) Like "##/#/" Then sDate = Left$(sDate, 3) & "0" & Mid$(sDate, 4)
    If sDate Like "##/##/##" Then sDate = Left$(sDate, 6) & "20" & Mid$(sDate, 7)
    sDate = Trim$(Replace(sDate, "/", ""))
    ' Abort if sDate is not correct
    DS = 0
    If Len(sDate) <> 8 Then
    MsgBox "ЗбКЗСнО ЫнС ХНнН: " & sDate
    Exit Function
    End If
    ' process string
    sOrder = UCase$(Left$(sOrder, 1)) ' Only 1st char is needed
    Select Case sOrder
    ' If day comes first
    Case "D"
    DD = Left$(sDate, 2)
    MM = Mid$(sDate, 3, 2)
    YYYY = Mid$(sDate, 5, 4)
    ' If month comes first
    Case "M"
    MM = Left$(sDate, 2)
    DD = Mid$(sDate, 3, 2)
    YYYY = Mid$(sDate, 5, 4)
    ' If year comes first
    Case "Y"
    YYYY = Left$(sDate, 4)
    MM = Mid$(sDate, 5, 2)
    DD = Mid$(sDate, 7, 2)
    End Select
    DS = DateSerial(YYYY, MM, DD)
    End Function

    The function is self-explanatory. DS is short for DateSerial.
    Of course, you may change DDMMYYYY in line 1 to MMDDYYYY if you like.

  15. #15
    Fanatic Member
    Join Date
    Jan 2013
    Posts
    894

    Re: Dating problem!

    Quote Originally Posted by Schmidt View Post
    Well, why not go all the way - do it properly - and use the official ISO-Date?
    http://xkcd.com/1179/
    http://en.wikipedia.org/wiki/ISO_8601

    VBs CDate-Function has no problems when fed with Strings, formatted in ISO-8601-Standard.
    Has the advantage, that you can then refer to what you're using under a proper name,
    instead of speculating about, if it's "perhaps Japanese" ...



    Sorry, but that's wrongly speculated - why not test this stuff before posting.

    Code:
    Private Sub Form_Load()
    'DateVars store negative Values just fine (they are Doubles underneath)
    Dim D As Date: D = -1
    
    'so, calculations in "Date-Space" work just like any other math
    Debug.Print CDbl(D), "Today: "; Date, "Yesterday: "; Date + D
    End Sub


    As said, when you talk about "Date Store" (and mean native VB-Date-Variables), those can keep negative Values just fine.
    Also the native Date-Fields in JET-DB-Tables (or other DBEngines) can take up such negative VB-Date-Values -
    and when you read them out per ADO-Rs, you'll see a perfectly fine VB-Date-delivery as well
    (their negative values not destroyed in such a "DB-Upload/DB-Retrieval - RoundTrip").

    So "Mem-Storage" and "DB-Storage" both work fine for negative values, and
    as already shown above, the math-calculations with VB-DateVars work directly as they should.

    As for your special problems with hh:mm:ss Time-Strings ...

    When those Strings are prefixed with either a "-" or a "+", then the CDate-Function will not eat them.
    CDate("03:00:00") works but neither does CDate("+03:00:00") nor CDate("-03:00:00")

    So, for that (respecting leading minus- or plus-chars) you will have to come up with your own StringToTime-function...

    Same thing for the opposite direction ... good Idea to write your own TimeToString-Function, ...
    Neither CStr(NegativeDateVar) nor Str(NegativeDateVar) nor FormatDateTime(NegativeDateVar, vbLongTime)
    support a negative TimeValue (the negative fraction of a Double). They always spit out a TimeString without
    the leading Minus-Sign.

    But that's String-Conversion-Stuff only. Native-Typed DateStorage works, as well as Native-Typed DateMath.

    Below is a more comprehensive example which demonstrates per code the things I've just mentioned:

    'Into a Form (Project will need a reference to ADO, and a small JET-DB is created dynamically in your Temp-Folder)
    Code:
    Option Explicit
    
    Private Sub Form_Load()
      TestDeltaDates
    End Sub
    
    Function TestDeltaDates()
    Dim FileName As String, Rs As Recordset, D As Date
        FileName = Environ("Temp") & "\testdates.mdb"
        
        CreateDB FileName, True
        OpenConn FileName
        
        Cnn.Execute "Create Table T(ID AutoIncrement, Delta Time)"
        
        'add 3 new DeltaTime-Records, fed over VBs Date-Type (containing Time-Values)
        Set Rs = GetRs("Select * From T Where 1=0")
               Rs.AddNew "Delta", StrToTime("-03:00:00")
               Rs.AddNew "Delta", StrToTime("+03:00:00")
               Rs.AddNew "Delta", StrToTime(" 00:00:00")
            Rs.UpdateBatch
     
        '----- now the read-out -----------
        D = CDate("2013-03-13 13:00:00") '<- VBs CDate() works flawlessly with ISO-8601-DateStrings
        
        Debug.Print "Rs-contained Deltas are added to the BaseDate below:"; vbCr; "BaseDate:", D, vbCr
        
        With GetRs("Select * From T")
          Do Until .EOF
            Debug.Print "FldType="; TypeName(!Delta.Value), TimeToStr(!Delta), D + !Delta
            .MoveNext
          Loop
        End With
        
        CloseConn
    End Function
    
    'the 2 one-liners below were just for fun (they work, but perhaps not with the best performance)
    Function StrToTime(S As String) As Date
      StrToTime = IIf(Val(S) < 0, -1, 1) * CDate(Replace(Replace(S, "+", 0), "-", 0))
    End Function
     
    Function TimeToStr(ByVal D As Date) As String
      TimeToStr = Choose(Sgn(D) + 2, "-", " ", "+") & D
    End Function

    'Some DBHelper-Functions for the above Form... into a *.bas-Module
    Code:
    Option Explicit
     
    Public Cnn As ADODB.Connection
     
    Public Sub CreateDB(mdbFileName As String, Optional ByVal OverwriteExisting As Boolean)
      If OverwriteExisting Then
        On Error Resume Next: Kill mdbFileName: On Error GoTo 0
      End If
      CreateObject("ADOX.Catalog").Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFileName
    End Sub
    
    Public Sub CloseConn()
      If Cnn Is Nothing Then Set Cnn = New ADODB.Connection
      If Not Cnn.State = adStateClosed Then Cnn.Close
    End Sub
    
    Public Sub OpenConn(mdbFileName As String)
      CloseConn 'since Cnn is a public Var (and DB-Files might change), we always try to close it first
      
      'since we ensured above, that Cnn is "closed and clean" we can change to a potentially different DB-File now...
      Cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mdbFileName
      Cnn.CursorLocation = adUseClient
      Cnn.Open
    End Sub
    
    Public Function GetRs(Query As String) As ADODB.Recordset
      Set GetRs = New ADODB.Recordset
      GetRs.Open Query, Cnn, adOpenStatic, adLockOptimistic
    End Function
    Olaf
    you are right!, I found odd that cdate do not handles signs like "-03:00:00", that way. But I uses a lot negative numerical values in Date variables as a result of a calculations.

    I thikns CDATE and others functions don't handle STRING_MINUS_SIGN conversions because the date offset that the numerical ZERO means. So, in real, a numerical negative is a positive year like by example, 1700/01/01.

    Negative dates are more usefull when calculating differences of time, because + * - / will actuate as if it were a DOUBLE variable, so everythings that comes about handling PERIODs of TIME will be great and easy.

    But the conversion of an inputed negative time (done intuitively)), that was the problem, and the program don't eat that.

    So, I ends with a simple, if sign then t=t-d else t=t+d

    ofcourse then, sign and d must be stored in the DB or binary file separately.

    anyway, I handled this problem years ago, and wasn't so fresh in my mind. But expressed it here, as a curiosity.
    Last edited by flyguille; Mar 14th, 2014 at 02:01 PM.

  16. #16
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: Dating problem!

    The time is stored in the date variable as the fractional part of a double; Seconds / 86400

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width