Timestamp, Multi-user issues.

[The_Vincester]

I use a timestamp field in my tables to help me with productivity metrics for about 6 individuals who use one of my databases.

The issue I have is that their system times are constantly "out of whack." We fix them, and it just happens again. It apparently another program on the computer that causes the issue, but I can't do anything about that.

Is there another timesource available for the timestamp when using now()? Is there a way to use the time of the server (shared) that the backend is on?

I have no idea how to fix this issue.

 

[ByteMyzer]

Are the computers on a Domain network? If they are, then you can use the time on the Primary Domain Controller.

Paste the following code into a new module:

Option Explicit

Type WKSTA_USER_INFO_1
    wkui1_username As Long
    wkui1_logon_domain As Long
    wkui1_logon_server As Long
    wkui1_oth_domains As Long
End Type

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 Type TIME_OF_DAY_INFO
    tod_elapsedt    As Long
    tod_msecs       As Long
    tod_hours       As Long
    tod_mins        As Long
    tod_secs        As Long
    tod_hunds       As Long
    tod_timezone    As Long
    tod_tinterval   As Long
    tod_day         As Long
    tod_month       As Long
    tod_year        As Long
    tod_weekday     As Long
End Type

Private Type TIME_ZONE_INFORMATION
    bias           As Long
    StandardName(0 To 63) As Byte
    StandardDate   As SYSTEMTIME
    StandardBias   As Long
    DaylightName(0 To 63) As Byte
    DaylightDate   As SYSTEMTIME
    DaylightBias   As Long
End Type

Public Declare Function NetWkstaUserGetInfo Lib "Netapi32" ( _
    Reserved As Any, _
    ByVal lLevel As Long, _
    pbBuffer As Any) _
    As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" ( _
    dest As Any, _
    Source As Any, _
    ByVal Bytes As Long)
Private Declare Function lstrlenW Lib "kernel32" ( _
    ByVal lpString As Long) _
    As Long
Private Declare Function NetRemoteTOD Lib "Netapi32" ( _
    bServer As Byte, _
    lpBuffer As Long) _
    As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32" ( _
    lpTimeZoneInformation As TIME_ZONE_INFORMATION) _
    As Long
Private Declare Sub GetLocalTime Lib "kernel32" ( _
    lpSystemTime As SYSTEMTIME)

Private Const NERR_SUCCESS As Long = 0&

Private Function GetUserDomain() As String

    Dim bDomain() As Byte
    Dim lLen As Long
    Dim pbBuffer As Long
    Dim wui1 As WKSTA_USER_INFO_1

    If NetWkstaUserGetInfo(ByVal 0&, 1&, pbBuffer) = 0 Then
        RtlMoveMemory wui1, ByVal pbBuffer, LenB(wui1)
        lLen = lstrlenW(wui1.wkui1_logon_domain) * 2
        If lLen > 0 Then
            ReDim bDomain(0 To lLen - 1)
            RtlMoveMemory bDomain(0), ByVal wui1.wkui1_logon_domain, lLen
            GetUserDomain = bDomain
        End If
    End If

End Function

Public Function GetRemoteDateTime() As Date

    Dim bServer() As Byte
    Dim lpBuffer As Long
    Dim lpSystemTime As SYSTEMTIME
    Dim lpTimeOfDayInfo As TIME_OF_DAY_INFO
    Dim lpTimeZoneInformation As TIME_ZONE_INFORMATION

    bServer = "\\" & GetUserDomain & vbNullChar

    If NetRemoteTOD(bServer(0), lpBuffer) = NERR_SUCCESS Then
        RtlMoveMemory lpTimeOfDayInfo, ByVal lpBuffer, LenB(lpTimeOfDayInfo)
        GetTimeZoneInformation lpTimeZoneInformation
        With lpSystemTime
            .wDay = lpTimeOfDayInfo.tod_day
            .wDayOfWeek = lpTimeOfDayInfo.tod_weekday
            .wHour = lpTimeOfDayInfo.tod_hours
            .wMilliseconds = lpTimeOfDayInfo.tod_msecs Mod 1000
            .wMinute = lpTimeOfDayInfo.tod_mins
            .wMonth = lpTimeOfDayInfo.tod_month
            .wSecond = lpTimeOfDayInfo.tod_secs
            .wYear = lpTimeOfDayInfo.tod_year
        End With
        GetLocalTime lpSystemTime
        With lpSystemTime
            If .wYear > 0 Then
                GetRemoteDateTime = DateSerial(.wYear, .wMonth, .wDay) _
                    + TimeSerial(.wHour, .wMinute, .wSecond)
            End If
        End With
    End If

End Function

You can use GetRemoteDateTime() instead of Now() in your application to ensure that all your users get the accurate time. Test this in the Debug window with:

? GetRemoteDateTime

See if this works for you.