检索当前本地计算机相对于 UTC 时间的小时数（使用 VBA）

Question

人们在多个时区使用我的项目。

为了转换时间戳，使用 VBA 仅检索本地计算机相对于 UTC 的当前小时数

的最快方法是什么？

Answer 1

方法一：使用“任意”API

Option Explicit

Function hoursOffsetFromUTC() As Single
    'returns current #hours difference between UTC & Local System Time
    'On Error GoTo uError
    Dim xmlHTTP As Object, strUTC As String, dtUTC As Date
    Set xmlHTTP = CreateObject("MSXML2.XMLHTTP")
    xmlHTTP.Open "GET", "https://maps.googleapis.com/maps/api/" & _
        "timezone/json?location=" & Int(Rnd() * 99) & ",0&timestamp=" & Int(Rnd() * 99), False
    xmlHTTP.send 'send randomized reqeust to avoid cached results
    strUTC = Mid(xmlHTTP.getResponseHeader("date"), 6, 20)
    Set xmlHTTP = Nothing
    dtUTC = DateValue(strUTC) + TimeValue(strUTC)
    hoursOffsetFromUTC = Round((Now() - dtUTC) * 48, 0) / 2 'nearest 0.5
    Exit Function
uError:
    MsgBox "Couldn't get UTC time." & vbLf & vbLf & _
        "Err#" & Err & ": " & Err.Description, vbExclamation, "Error!"
End Function

用法示例：

MsgBox hoursOffsetFromUTC

方法二：使用Windows API

---

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_ZONE_INFORMATION
    Bias As LongPtr
    StandardName(0 To 31) As Integer
    StandardDate As SYSTEMTIME
    StandardBias As LongPtr
    DaylightName(0 To 31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As LongPtr
End Type

Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Function hoursOffsetFromUTC_Win() As Single
    Dim TZI As TIME_ZONE_INFORMATION
    If GetTimeZoneInformation(TZI) = 2 Then
        hoursOffsetFromUTC_Win = 0 - ((TZI.Bias + TZI.DaylightBias) / 60)
    Else
        hoursOffsetFromUTC_Win = 0 - (TZI.Bias / 60)
    End If
End Function

用法示例：

MsgBox hoursOffsetFromUTC_Win

---

方法一

代码较少，但需要互联网连接。它使用随机数调用 Google API 以避免缓存，并忽略响应正文，它获取响应标头中返回的请求日期并将其与本地系统时间进行比较。 （可以使用任何在标头中返回当前 UTC/GMT 的 API。）

方法二

需要声明两种类型和一个外部函数，但无需互联网连接即可运行，使用 Windows 内部 kernel32 API 的功能。

转换时间戳：

---

要将数字 Unix/纪元时间戳转换为“
• Excel Time

  ”： ( 时间戳 / 86400 ) + 25569 = ExcelTime

或者相反，从 Excel 到纪元时间戳：

• ( ExcelTime - 25569 ) * 86400 = 时间戳

（这些不包含时区调整，所以您可以根据需要添加/减去。）

更多信息：

---

维基百科：

• Unix时间和数字时间戳

EpochConverter：

• Epoch 和 Unix 时间戳转换工具

Chip Pearson：

• 时区和夏令时（Windows API）

堆栈溢出：

• 在任意时区之间转换（区域→区域）

Microsoft 支持：

• 如何在 Excel 中使用时间和日期

Answer 2

Powershell

:) 我已经学会了如何在 Powershell 中获取 UTC 偏移量。简单来说就是：

[System.TimeZone]::CurrentTimeZone.GetUtcOffset([datetime]::Now).TotalMinutes / 60

现在，我们将其添加到 VBA 中：

Function GetUtcOffsetHours() As Double
    ' returns UTC offset of this computer in hours
    Dim shell As Object, exec As Object, offsetHours As Double, output As String
    
    'save data for the next session to increase speed
    Static bTZacquired As Boolean:       Static tz As Double

    ' save time for pre-processed tz in the current session
    If bTZacquired = True Then
        GetUtcOffsetHours = tz:          Exit Function
    End If
    
    ' Create a new WScript.Shell object
    Set shell = CreateObject("WScript.Shell")

    ' Run the PowerShell command and capture the output
    Set exec = shell.exec("powershell.exe -command ""[System.TimeZone]::CurrentTimeZone.GetUtcOffset([datetime]::Now).TotalMinutes / 60""")
    
    ' Read the output
    Do While Not exec.StdOut.AtEndOfStream
        output = output & exec.StdOut.ReadAll
    Loop

    ' Convert the output to a double (keep in mind half-an-hour timezones! i.e. Kolkata)
    offsetHours = CDbl(Trim(output))
    
    ' Return the result
    tz = offsetHours: bTZacquired = True
    GetUtcOffsetHours = offsetHours
    
End Function

TZ

值被保存到内存中以加快进一步的执行速度（您很少会在一个 Excel 会话中更改时区...）。第一次迭代需要 0.58 秒。