我正在尝试使用此方法在Access 2010/13中实现毫秒时间戳; MS Access Can Handle Millisecond Time Values--Really - See more at: http://www.devx.com/dbzone/Article/39046#sthash.xEIruMyE.dpuf
函数Msec（2）应该以毫秒为单位返回系统时间，但似乎大约需要10个小时。
Public Function Msec( _
Optional ByVal intTimePart As Integer) _
As Date
' This is the core function.
' It generates the current time with millisecond resolution.
'
' Returns current (local) date/time including millisecond.
' Parameter intTimePart determines level of returned value:
' 0: Millisecond value only.
' 1: Time value only including milliseconds.
' 2: Full Date/time value including milliseconds.
' None or any other value: Millisecond value only.
Const cintMsecOnly As Integer = 0
Const cintMsecTime As Integer = 1
Const cintMsecDate As Integer = 2
Static typTime As SYSTEMTIME
Static lngMsecInit As Long
Dim datMsec As Date
Dim datDate As Date
Dim intMilliseconds As Integer
Dim lngTimeZoneBias As Long
Dim lngMsec As Long
Dim lngMsecCurrent As Long
Dim lngMsecOffset As Long
' Set resolution of timer to 1 ms.
timeBeginPeriod 1
lngMsecCurrent = timeGetTime()
If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
' Initialize.
' Get bias for local time zone respecting
' current setting for daylight savings.
lngTimeZoneBias = GetLocalTimeZoneBias(False)
' Get current UTC system time.
Call GetSystemTime(typTime)
intMilliseconds = typTime.wMilliseconds
' Repeat until GetSystemTime retrieves next count of milliseconds.
' Then retrieve and store count of milliseconds from launch.
Do
Call GetSystemTime(typTime)
Loop Until typTime.wMilliseconds <> intMilliseconds
lngMsecInit = timeGetTime()
' Adjust UTC to local system time by correcting for time zone bias.
typTime.wMinute = typTime.wMinute - lngTimeZoneBias
' Note: typTime may now contain an invalid (zero or negative) minute count.
' However, the minute count is acceptable by TimeSerial().
Else
' Retrieve offset from initial time to current time.
lngMsecOffset = lngMsecCurrent - lngMsecInit
End If
With typTime
' Now, current system time is initial system time corrected for
' time zone bias.
lngMsec = (.wMilliseconds + lngMsecOffset)
Select Case intTimePart
Case cintMsecTime, cintMsecDate
' Calculate the time to add as a date/time value with millisecond resolution.
datMsec = lngMsec / 1000 / clngSecondsPerDay
' Add to this the current system time.
datDate = datMsec + TimeSerial(.wHour, .wMinute, .wSecond)
If intTimePart = cintMsecDate Then
' Add to this the current system date.
datDate = datDate + DateSerial(.wYear, .wMonth, .wDay)
End If
Case Else
' Calculate millisecond part as a date/time value with millisecond resolution.
datMsec = (lngMsec Mod 1000) / 1000 / clngSecondsPerDay
' Return millisecond part only.
datDate = datMsec
End Select
End With
Msec = datDate
End Function
杰克哈德卡斯尔说;可能与时区有关。
它永远不会运行此代码;
If lngMsecInit = 0 Or lngMsecCurrent < lngMsecInit Then
' Initialize.
' Get bias for local time zone respecting
' current setting for daylight savings.
lngTimeZoneBias = GetLocalTimeZoneBias(False)
' Get current UTC system time.
Call GetSystemTime(typTime)
intMilliseconds = typTime.wMilliseconds
' Repeat until GetSystemTime retrieves next count of milliseconds.
' Then retrieve and store count of milliseconds from launch.
Do
Call GetSystemTime(typTime)
Loop Until typTime.wMilliseconds <> intMilliseconds
lngMsecInit = timeGetTime()
' Adjust UTC to local system time by correcting for time zone bias.
typTime.wMinute = typTime.wMinute - lngTimeZoneBias
' Note: typTime may now contain an invalid (zero or negative) minute count.
' However, the minute count is acceptable by TimeSerial().
但是去了;
Else
' Retrieve offset from initial time to current time.
lngMsecOffset = lngMsecCurrent - lngMsecInit
End If
答！来自@pathDongle
时间存储为毫秒UTC;
!DateTimeMS = GetTimeUTC()
并恢复;
Public Function UTCtoTimeLocal(dSysUTC As Date) As Date
'Dim sysTime As SYSTEMTIME
Dim DST As Long
Dim tzi As TIME_ZONE_INFORMATION
DST = GetTimeZoneInformation(tzi)
UTCtoTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function
查询;
SELECT tblzzAuditTrail.DateTimeMS, FormatDate(UTCtoTimeLocal([DateTimeMS])) AS DateTimeLocal
可以作为字符串过滤。
Private Sub BuildFilter()
Dim strFilter As String
Dim ctl As Control
strFilter = ""
'add selected values to string
For Each ctl In Me.FormHeader.Controls
With ctl
If .ControlType = acTextBox Or .ControlType = acComboBox Then
If Nz(.Value) <> "" Then
If InStr(.Name, "Date") <> 0 Then
If Nz(StartDate) <> "" And Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] BETWEEN '" & FormatDate(Me.StartDate.Value) & "' AND '" & FormatDate(Me.EndDate.Value) & "' AND "
ElseIf Nz(StartDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] > '" & FormatDate(Me.StartDate.Value) & "' AND "
ElseIf Nz(EndDate) <> "" And InStr(strFilter, "DateTimeLocal") = 0 Then
strFilter = strFilter & "[DateTimeLocal] <= '" & FormatDate(Me.EndDate.Value) & "' AND "
End If
ElseIf InStr(.Name, "ID") <> 0 Then
strFilter = strFilter & "[" & .Name & "] = " & .Value & " AND "
Else
strFilter = strFilter & "[" & .Name & "] = '" & .Value & "' AND "
End If
End If
End If
End With
Next ctl
'trim trailing And
strFilter = TrimR(strFilter, 5)
Debug.Print strFilter
With Me.subfrmzzAuditTrailDisplay
.Form.Filter = strFilter
.Form.FilterOn = True
End With
End Sub
产生的过滤字符串;
[UserID] = 2 AND [DateTimeLocal] BETWEEN '06/01/2015 00:00:00.000' AND '07/01/2015 00:00:00.000'
根据我的另一个问题;
答案 0 :(得分：1)
大多数这些功能可以简化为以下内容：
函数GetTimeLocal将返回用户本地系统日期时间和夏令时调整
函数GetTimeUTC将返回UTC时间
函数FormatDate将Date格式化为具有正确毫秒组件的字符串。
通常最好将所有时间存储为UTC并在需要时进行转换。
Option Explicit
#If Win64 Then
Public Declare PtrSafe Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#Else
Public Declare Sub GetSystemTime Lib "kernel32" (ByRef lpSystemTime As SYSTEMTIME)
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
#End If
Public 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_ZONE_INFORMATION
Bias As Long
StandardName(31) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(31) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Sub test()
Dim dtLcl As Date
Dim dtUTC As Date
dtLcl = GetTimeLocal 'Gets local time including adjustement for daylight saving time
dtUTC = GetTimeUTC 'Gets UTC time
Debug.Print FormatDate(dtLcl)
Debug.Print FormatDate(dtUTC)
End Sub
Function FormatDate(ByVal dt As Date) As String
Dim sysTime As SYSTEMTIME
Dim sec As Double
Dim x As Double
With sysTime
.wYear = Year(dt)
.wMonth = Month(dt)
.wDay = Day(dt)
.wHour = Hour(dt)
.wMinute = Minute(dt)
'Second() function rounds to nearest second so calc floor second
'Eg 12:15:09.678 will give second component as 10 instead of 09
x = (dt - Int(dt)) * 86400#
sec = x - Fix(x / 60#) * 60#
.wSecond = Int(sec)
.wMilliseconds = Int(Round(sec - .wSecond, 3) * 1000)
FormatDate = Format(dt, "dd/mm/yyyy hh:mm:ss.") & Format(sysTime.wMilliseconds, "000")
End With
End Function
Public Function GetTimeLocal() As Date
Dim dSysUTC As Date, sysTime As SYSTEMTIME
Dim DST As Long, IsDST As Boolean
Dim tzi As TIME_ZONE_INFORMATION
Dim ms As Double
GetSystemTime sysTime
With sysTime
'Debug.Print "ms=" & .wMilliseconds
ms = CDbl(.wMilliseconds) / (86400# * 1000#)
dSysUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
End With
DST = GetTimeZoneInformation(tzi)
GetTimeLocal = dSysUTC - TimeSerial(0, tzi.Bias, 0) + IIf(DST = 2, TimeSerial(1, 0, 0), 0)
End Function
Public Function GetTimeUTC() As Date
Dim dSysUTC As Date
Dim sysTime As SYSTEMTIME
Dim ms As Double
GetSystemTime sysTime
With sysTime
'Debug.Print "ms=" & .wMilliseconds
ms = CDbl(.wMilliseconds) / (86400# * 1000#)
GetTimeUTC = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond) + ms
End With
End Function