How to add milliseconds to Now()?

[neelsfer]

I need to add milliseconds to this finishtime of race

[Forms]![RaceSetupttF]![RaceTimingTTSF1]![RaceFinishTime] = Format(Now(), "General Date")

Start code for race also in milliseconds

[Forms]![RaceSetupttF]![Rt_StartTTSF]![startTT] = Format(Now(), "General Date")

I will then subtract it from the start time and get a result in milliseconds

RacingTime: Format([Racefinishtime]-[startTT],"hh:nn:ss")

Any suggestions on how this can be accomplished?

[TheSmileyCoder]

Access Now() will only record as accurate as down to 1 second. So you can't use that. I also dont think (but dont know for sure) that you can store time in date/time field more accurately then down to the second. And you will still need to custom format it when you want to display it.

Now this is something I use to time my procedures to see how long they take, and how different approaches can shorten the run time.

Place this code in a CLASS module called StopWatch. (I did not write the original code, though I did modify it somewhat)

Private mlngStart As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Public Sub StartTimer()
    mlngStart = GetTickCount
End Sub
 
Public Function EndTimer() As String
    Dim EndTime As Long
    EndTime = (GetTickCount - mlngStart)
    Dim s As Integer
    s = EndTime / 1000
    Dim ms As Integer
    ms = EndTime Mod 1000
    If s > 1 Then
        EndTimer = s & "s, " & ms & "ms"
    Else
        EndTimer = ms & "ms"
    End If
End Function

When I use this timer it looks like this:

Private sub MyFunction()
  'Start stopwatch
  Dim mySW as stopwatch
  mySW.StartTimer
 
  'Rest of my code goes here
 
  'Reached the end of code, printout how long it took to run it
  Debug.Print "MyFunction ran in:" & mySW.EndTimer
End Sub

[ADezii]

http://bytes.com/topic/access/insigh...lliseconds-vba

[neelsfer]

Thx for the advice so far. I am struggling with modules and to link to them from a button.
i am attaching part of the application ( deleted parts of it to make it smaller)
How do i add these milliseconds functions to the "Start Rider" and "Add time" buttons? Both buttons use Now() currently. Will it be different to deduct the finish and start times now? Please help.

[ADezii]

The way that I see things is that what you are requesting would be difficult to implement, for the reasons given by TheSmileyOne. You can display the Current Time as 16:48:01:0913, but since this is not a true Date Value, you would not be able to perform mathematical calculations on in without the addition of some innovative Code.

[neelsfer]

The only calculation i am going to have for this milliseconds on one of my forms, is finishtime minus starttime (with mulliseconds), No additions required etc. Is that possible?
Its for a specific type of racing called timetrial where they race individually from point A to B and back to A. You may have 2 persons with the same racingtime and that's where the milliseconds come in

[Stewart Ross]

I've adapted the code originally supplied by Mary to return the system time in milliseconds as a long int value. This can be used as in the test function to assign times then subtract them afterwards to get the true difference in milliseconds.

I hope this helps.

Option Compare Database
Option Explicit
 
Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type
 
 
Private Declare Sub GetSystemTime Lib "kernel32" _
(lpSystemTime As SYSTEMTIME)
 
Public Function TimeToMillisecond() As Long
    Dim tSystem As SYSTEMTIME
    Dim sRet As Long
    On Error Resume Next
    GetSystemTime tSystem
    With tSystem
        sRet = (CLng(.wHour) * 60 * 60 * 1000) + (CLng(.wMinute) * 60 * 1000) + CLng(.wSecond) * 1000 + .wMilliseconds
    End With
    TimeToMillisecond = sRet
End Function
 
 
 
Public Function TimeTest()
    Dim lngV1 As Long, lngV2 As Long, lngCounter As Long
    lngV1 = TimeToMillisecond
    For lngCounter = 1 To 1000000000
    Next
    lngV2 = TimeToMillisecond
    Debug.Print "First Time: " & lngV1, "Second Time: " & lngV2, "Diff (ms): " & lngV2 - lngV1
End Function
 

Example of test run:

? TimeTest
First Time: 37081308 Second Time: 37088349 Diff (ms): 7041

-Stewart

[Stewart Ross]

Oops. I forgot to provide a way to show the system time in ms in its normal form:

Public Function ShowSysTime(ByVal Tms As Long) As String
    Const MsInHour = 3600000
    Const MsinMin = 60000
    Const MsInSec = 1000
    Dim lngHrs As Long
    Dim lngMins As Long
    Dim lngSecs As Long
    Dim lngMs As Long
    lngHrs = Tms \ MsInHour
    Tms = Tms - (lngHrs * MsInHour)
    lngMins = Tms \ MsinMin
    Tms = Tms - (lngMins * MsinMin)
    lngSecs = Tms \ MsInSec
    Tms = Tms - (lngSecs * MsInSec)
    lngMs = Tms
    ShowSysTime = Format(lngHrs, "00") & ":" & Format(lngMins, "00") & ":" & Format(lngSecs, "00") & ":" & Format(lngMs, "000")
End Function

Test run:
? ShowSysTime(Tim eToMillisecond)
10:38:19:478

-Stewart

PS Please note that neither Mary's original code nor my adapted versions above handle transitions from one day to the next where the times extend past midnight (e.g. for 23:30:00:567 to 00:01:30:123). The SystemTime type does contain a .wDay component that could be used in extending the code provided for that purpose if necessary.

[neelsfer]

thx for the trouble. How do i incorporate it into a form and link it to a button. I am novice but learning fast.

[ADezii]

The following Code takes a radically different approach, and incorporates all logic in a single Function Procedure. It accepts 2, precisely formatted String Arguments representing Time Values in the Format of:

hh:nn:ss:llll
h = Hours
n = Minutes
s = seconds
l = Milliseconds
 
Examples:
12:43:13:0854
23:02:58:0012
 

The Function will then return the Time Difference in Milliseconds. For the sake of simplicity and brevity, it performs minimal Validations on the Inputs and does not take into consideration the Midnight barrier. I don't really think this would apply to races anyway. I have not spent that much time on the Logic, so it may need a little work.

P.S. - I'll post the Code, but feel free to Download the Attachment, play with it, and see what you think. Any questions, feel free to ask.

Public Function fCalcTimeDifference(strStart As String, strFinish As String) As Long
Dim dteStart As Date
Dim dteFinish As Date
Dim lngMilliDiff As Long
Dim lngStartMilliSecs As Long
Dim lngFinishMilliSecs As Long
 
'Extract Real Time Values from strStart minus Milliseconds
dteStart = TimeValue(Left$(strStart, 8))
dteFinish = TimeValue(Left$(strFinish, 8))
lngStartMilliSecs = Val(Right$(strStart, 4))
lngFinishMilliSecs = Val(Right$(strFinish, 4))
 
'If the Base Times are equal, and the only difference is in Milliseconds, as in:
'11:30:10:0099 - 11:30:10:0345
If (dteStart = dteFinish) And (lngFinishMilliSecs > lngStartMilliSecs) Then
  fCalcTimeDifference = (lngFinishMilliSecs - lngStartMilliSecs)
    'Debug.Print dteStart & " ==> " & dteFinish
Else        'Start Time <> Finish Time
  'Check the Millisecond Component of the time to see if Finish Millisecond >
  'Start Millisecond, if this is not true, then we need to 'borrow' 1 second
  '(1,000 Millisecond) from the Finish
  If lngFinishMilliSecs > lngStartMilliSecs Then      'We're good
    'Convert Time Differential in Milliseconds
    lngMilliDiff = (DateDiff("s", dteStart, dteFinish) * 1000) + _
                   (lngFinishMilliSecs - lngStartMilliSecs)
      fCalcTimeDifference = lngMilliDiff
  Else
    'Need to 'borrow' 1 second from Finish Time and add it to Milliseconds Component
    dteFinish = DateAdd("s", -1, dteFinish)       'Borrowed a second, will add to
                                                  'Millisecond Component
      lngMilliDiff = (DateDiff("s", dteStart, dteFinish) * 1000) + _
                     ((lngFinishMilliSecs + 1000) - lngStartMilliSecs)
      fCalcTimeDifference = lngMilliDiff
  End If
End If
End Function