vba - 将 UTC 时间转换为本地时间

标签 vba ms-access

我有一个在两个不同时区使用的 MS Access 应用程序。相差7小时。我需要找一个两个办公室都休息的时间,这样我就可以关闭他们的数据库,然后我可以对它们进行压缩、修复和备份。

因此,我不需要创建两个单独的前端,我告诉一个在下午 1000 点关闭数据库,另一个在凌晨 4 点关闭数据库,我发现我可以说在 UTC 上午 00:30 关闭数据库。 但我不知道如何在本地转换相同的值。 现在我关闭数据库的代码如下所示:

Private Sub Form_Timer()
Dim RunAtLocalTime As String

RunAtLocalTime = Format(Now(), "HH:MM:SS")
If RunAtLocalTime = ("00:00:00") Then
        DoCmd.Quit
End If
End Sub

我想做这样的事情:

Private Sub Form_Timer()
Dim RunAtLocalTime As String
Dim UTCTIME As 

'''RunAtLocalTime = Convert(UTCTIME)
 RunAtLocalTime = Format(Now(), "HH:MM:SS")
 If RunAtLocalTime = ("00:00:00") Then
        DoCmd.Quit
End If
End Sub

最佳答案

Caution!

请注意您使用的时区转换方法,包括与 UTC 标准之间的转换。时区的规则(包括夏令时的差异)一开始就令人困惑,因为它们不仅因地区或国家而异,在某些情况下还因州或县而异。

更令人困惑的是,规则在不断演变,因此出于逻辑原因(就像地球上剩下的一半,希望朝着消除夏令时的方向发展),有时不那么合乎逻辑(国家领导人一时兴起改变规则),以及其他时候沟通不当 ( case study: Turkey's 2015 Chaos )。

即使是加拿大/美国也有一个 major change in 2007,编码员经常忘记考虑这一点。 此网站(或此页面!)上的其他解决方案在某些情况或时间范围内计算错误。

理想情况下,我们都可以使用相同的方法从同一个地方获取信息。 future 和历史时区信息的权威被认为是tz database发布的related codeiana.org

<小时/>

Solution!

以下转换方法解释了所有夏令时和时区差异,我通过长时间的分析和权威文档(例如 Unicode 的 Common Locale Data Repository )认真确认了这一点。

为了节省空间和效率,我最大限度地减少了空间,只包含与我的目的相关的功能:UTC 时间和本地时间之间的转换,以及 Epoch 时间戳和本地时间之间的转换。这是 Tim Hall 对 code 的改编。
纪元时间戳,也称为 Unix 时间,是自 1970 年 1 月 1 日以来的秒数,在许多 API 和其他应用程序中用作标准时间格式编程资源。更多信息请 Access epochconverter.com Wikipedia

我建议将其单独放置在一个模块中。

Option Explicit
'UTC/Local Time Conversion
'Adapted from code by Tim Hall published at https://github.com/VBA-tools/VBA-UtcConverter

'PUBLIC FUNCTIONS:
'    - UTCtoLocal(utc_UtcDate As Date) As Date     converts UTC datetimes to local
'    - LocalToUTC(utc_LocalDate As Date) As Date   converts local DateTime to UTC
'    - TimestampToLocal(st As String) As Date      converts epoch timestamp to Local Time
'    - LocalToTimestamp(dt as date) as String      converts Local Time to timestamp
'Accuracy confirmed for several variations of time zones & DST rules. (ashleedawg)
'===============================================================================

Private Type utc_SYSTEMTIME
    utc_wYear As Integer: utc_wMonth As Integer: utc_wDayOfWeek As Integer: utc_wDay As Integer
    utc_wHour As Integer: utc_wMinute As Integer: utc_wSecond As Integer: utc_wMilliseconds As Integer
End Type

Private Type utc_TIME_ZONE_INFORMATION
    utc_Bias As Long: utc_StandardName(0 To 31) As Integer: utc_StandardDate As utc_SYSTEMTIME: utc_StandardBias As Long
    utc_DaylightName(0 To 31) As Integer: utc_DaylightDate As utc_SYSTEMTIME: utc_DaylightBias As Long
End Type

'http://msdn.microsoft.com/library/windows/desktop/ms724421.aspx /ms724949.aspx /ms725485.aspx
Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long

Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME ' "Helper Function" for Public subs (below)
    With utc_DateToSystemTime
        .utc_wYear = Year(utc_Value): .utc_wMonth = Month(utc_Value): .utc_wDay = Day(utc_Value)
        .utc_wHour = Hour(utc_Value): .utc_wMinute = Minute(utc_Value): .utc_wSecond = Second(utc_Value): .utc_wMilliseconds = 0
    End With
End Function

Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date ' "Helper Function" for Public Functions (below)
    utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _
        TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)
End Function

'===============================================================================
Public Function TimestampToLocal(st As String) As Date
    TimestampToLocal = UTCtoLocal((Val(st) / 86400) + 25569)
End Function
Public Function LocalToTimestamp(dt As Date) As String
    LocalToTimestamp = (LocalToUTC(dt) - 25569) * 86400
End Function

Public Function UTCtoLocal(utc_UtcDate As Date) As Date
    On Error GoTo errorUTC
    Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION, utc_LocalDate As utc_SYSTEMTIME
    utc_GetTimeZoneInformation utc_TimeZoneInfo
    utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate
    UTCtoLocal = utc_SystemTimeToDate(utc_LocalDate)
    Exit Function
errorUTC:
    Debug.Print "UTC parsing error: " & Err.Number & " - " & Err.Description: Stop
End Function

Public Function LocalToUTC(utc_LocalDate As Date) As Date
    On Error GoTo errorUTC
    Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION, utc_UtcDate As utc_SYSTEMTIME
    utc_GetTimeZoneInformation utc_TimeZoneInfo
    utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate
    LocalToUTC = utc_SystemTimeToDate(utc_UtcDate)
    Exit Function
errorUTC:
    Debug.Print "UTC conversion error: " & Err.Number & " - " & Err.Description: Stop
End Function

我知道这似乎是一个可怕的大量代码,只是为了一次添加/减去几个小时,但我煞费苦心地研究,希望找到一种可靠的更短/更简单的方法,保证在当前的情况下都是准确的和历史时代,但没有成功。使用此方法所需的只是复制和粘贴。 ☺

<小时/>

用法示例:

Sub testTZC()
'(Note that "Local time" in these examples is Vancouver/Los Angeles)
    MsgBox LocalToUTC("2004-04-04 01:00") 'returns: 2004-04-04 9:00:00 AM (not DST)
    MsgBox LocalToUTC("2004-04-04 03:00") 'returns: 2004-04-04 10:00:00 AM (is DST)
    MsgBox UTCtoLocal("2000-01-01 00:00") 'returns: 1999-12-31 4:00:00 PM
    MsgBox TimestampToLocal("1234567890") 'returns: 2009-02-13 3:31:30 PM
    MsgBox LocalToTimestamp("April 17, 2019 7:45:55 PM") 'returns: 1555555555
End Sub

关于vba - 将 UTC 时间转换为本地时间,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/23903872/

相关文章:

excel - 更改单元格颜色时下标超出范围错误

vba - 将更新的 Excel VBA 代码分发给多个最终用户

regex - 使用 VBA 从文本文件写入 Excel 时保留 "columns"

java - 如何在不使用 SQL 服务器的情况下实现 Blue J (Java) 的 Access 数据库?

ms-access - Microsoft Access 2013 长文本限制为 255

VBA Excel,输入框作为整数不匹配

Excel 工作簿打开事件宏并不总是运行

excel - 为什么 ADO 连接即使在只读状态下仍会创建 "ldb"锁定文件?

azure - Access 链接表 - 无需保存密码即可登录

vba - 为什么某些 VBA 错误不触发错误处理?