如何从Excel VBA宏中获取当前UTC日期时间

Question

在 Excel VBA 宏中，有没有一种方法可以以 UTC 格式获取当前日期时间？

我可以调用 Now() 获取当前本地时区的时间；是否有通用的方法将其转换为 UTC？

- Jon

Answer 1

简单地说，您可以使用 COM 对象来获取UTC时间信息。

Dim dt As Object, utc As Date
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
utc = dt.GetVarDate(False)

- gogeek

---

太好了！这个会考虑夏令时吗？@gogeek - MS Sankararaman

@MeenakshiSundharam UTC 没有夏令时，但是，根据当前的本地时间，您可以计算出当前的时区偏移量（包括夏令时）。 - ashleedawg

这应该是被接受的答案 - 它既高效又简短，正如代码应该是的那样。 - JasperD

优秀的代码。只想提一下，“Now”可以替换为任何带有日期和时间的日期变量，因此它不需要是当前时间。它将转换任何日期和时间为UTC。太棒了gogeek。 - John Muggins

Answer 2

http://excel.tips.net/Pages/T002185_Automatically_Converting_to_GMT.html

该页面上有一个带有LocalTimeToUTC方法的宏，看起来可以解决问题。如果您想采用公式示例，则还提供了一些示例。

编辑 - 另一个链接。http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx此页面有几种日期/时间方法可供选择。两种方法都可以解决问题，但我觉得第二种更加美观。

- brad.huffman

---

哎呀，两者都使用Windows API调用，但如果这是唯一的方法，那就这样吧。谢谢。 - Jon

Answer 3

虽然这个问题有点老，但我花了一些时间根据这个问题整理了一些干净的代码，并希望在这里发布，以防有人遇到这个页面时可能会发现它有用。

在Excel VBA IDE中创建一个新模块（可选择在属性表中命名为UtcConverter或您喜欢的任何名称），并粘贴下面的代码。

希望对你有所帮助。

Option Explicit

' Use the PtrSafe attribute for x64 installations
Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "Kernel32" (lpFileTime As FILETIME, ByRef lpLocalFileTime As FILETIME) As Long
Private Declare PtrSafe Function LocalFileTimeToFileTime Lib "Kernel32" (lpLocalFileTime As FILETIME, ByRef lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function SystemTimeToFileTime Lib "Kernel32" (lpSystemTime As SYSTEMTIME, ByRef lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function FileTimeToSystemTime Lib "Kernel32" (lpFileTime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Long

Public Type FILETIME
  LowDateTime As Long
  HighDateTime As Long
End Type

Public Type SYSTEMTIME
  Year As Integer
  Month As Integer
  DayOfWeek As Integer
  Day As Integer
  Hour As Integer
  Minute As Integer
  Second As Integer
  Milliseconds As Integer
End Type


'===============================================================================
' Convert local time to UTC
'===============================================================================
Public Function UTCTIME(LocalTime As Date) As Date
  Dim oLocalFileTime As FILETIME
  Dim oUtcFileTime As FILETIME
  Dim oSystemTime As SYSTEMTIME

  ' Convert to a SYSTEMTIME
  oSystemTime = DateToSystemTime(LocalTime)

  ' 1. Convert to a FILETIME
  ' 2. Convert to UTC time
  ' 3. Convert to a SYSTEMTIME
  Call SystemTimeToFileTime(oSystemTime, oLocalFileTime)
  Call LocalFileTimeToFileTime(oLocalFileTime, oUtcFileTime)
  Call FileTimeToSystemTime(oUtcFileTime, oSystemTime)

  ' Convert to a Date
  UTCTIME = SystemTimeToDate(oSystemTime)
End Function



'===============================================================================
' Convert UTC to local time
'===============================================================================
Public Function LOCALTIME(UtcTime As Date) As Date
  Dim oLocalFileTime As FILETIME
  Dim oUtcFileTime As FILETIME
  Dim oSystemTime As SYSTEMTIME

  ' Convert to a SYSTEMTIME.
  oSystemTime = DateToSystemTime(UtcTime)

  ' 1. Convert to a FILETIME
  ' 2. Convert to local time
  ' 3. Convert to a SYSTEMTIME
  Call SystemTimeToFileTime(oSystemTime, oUtcFileTime)
  Call FileTimeToLocalFileTime(oUtcFileTime, oLocalFileTime)
  Call FileTimeToSystemTime(oLocalFileTime, oSystemTime)

  ' Convert to a Date
  LOCALTIME = SystemTimeToDate(oSystemTime)
End Function



'===============================================================================
' Convert a Date to a SYSTEMTIME
'===============================================================================
Private Function DateToSystemTime(Value As Date) As SYSTEMTIME
  With DateToSystemTime
    .Year = Year(Value)
    .Month = Month(Value)
    .Day = Day(Value)
    .Hour = Hour(Value)
    .Minute = Minute(Value)
    .Second = Second(Value)
  End With
End Function



'===============================================================================
' Convert a SYSTEMTIME to a Date
'===============================================================================
Private Function SystemTimeToDate(Value As SYSTEMTIME) As Date
  With Value
    SystemTimeToDate = _
      DateSerial(.Year, .Month, .Day) + _
      TimeSerial(.Hour, .Minute, .Second)
  End With
End Function

- InteXX

Answer 4

如果您只需要当前时间，可以使用GetSystemTime来实现，这涉及较少的Win32调用。它会给您一个带有毫秒精度的时间结构体，您可以根据需要进行格式化：

Private Declare PtrSafe Sub GetSystemTime Lib "Kernel32" (ByRef lpSystemTime As SYSTEMTIME)

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

使用方法：

Dim nowUtc As SYSTEMTIME
Call GetSystemTime(nowUtc) 
' nowUtc is now populated with the current UTC time. Format or convert to Date as needed.

- user1454265

---

请问您需要翻译什么程序相关内容？ - Marc

Answer 5

叹气。这个问题是关于Excel VBA的，而不是关于“Excel VBA for Windows”的。 简而言之，无论答案得到多少赞，都不能在Mac或Linux上运行（是的，Office，至少Office 2000也可以在Linux上运行）。

所以这就是我的答案。可预测它会得到零票，但事实并不是一个选美比赛。

对于Windows，请参阅其他答案（那些默默地假设Windows，展示了程序员通过假设事物而创建问题）。

对于Mac，请参阅https://macscripter.net/viewtopic.php?id=41117。

对于Linux，请参阅How do I get GMT time in Unix? 祝玩得开心。很抱歉这么干巴，但周围有太多的近似值，S.O.现在变得可怕了。

- Yves Champollion

---

请提供与Excel或VBA有关的链接。 - undefined

Answer 6

我的Access项目主要与链接到MS SQL Server表的Access表一起工作。这是一个DAO项目，我甚至在让带有GETUTCDATE()的SQL sproc返回时遇到了麻烦。但以下是我的解决方案。

-- Create SQL table with calculated field for UTCDate
CREATE TABLE [dbo].[tblUTCDate](
    [ID] [int] NULL,
    [UTCDate]  AS (getutcdate())
) ON [PRIMARY]
GO

创建一个Access表，名为dbo_tblUTCDate，通过ODBC连接到SQL表tblUTCDate。

创建一个Access查询以从Access表中选择数据。我将其命名为qryUTCDate。

SELECT dbo_tblUTCDate.UTCDate FROM dbo_tblUTCDate

在VBA中：

Dim db as DAO.database, rs AS Recordset
Set rs = db.OpenRecordset("qryUTCDate")
Debug.Print CStr(rs!UTCDATE)
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing

- skankyblackbird

Answer 7

如果您还需要考虑夏令时，您可能会发现以下代码有用：

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API Structures
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type SYSTEM_TIME
    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(0 To 31) As Integer
    StandardDate As SYSTEM_TIME
    StandardBias As Long
    DaylightName(0 To 31) As Integer
    DaylightDate As SYSTEM_TIME
    DaylightBias As Long
End Type    

'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Windows API Imports
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function GetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Function TzSpecificLocalTimeToSystemTime Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION, lpLocalTime As SYSTEM_TIME, lpUniversalTime As SYSTEM_TIME) As Integer

Function ToUniversalTime(localTime As Date) As Date
    Dim timeZoneInfo As TIME_ZONE_INFORMATION

    GetTimeZoneInformation timeZoneInfo

    Dim localSystemTime As SYSTEM_TIME
    With localSystemTime
        .wYear = Year(localTime)
        .wMonth = Month(localTime)
        .wDay = Day(localTime)
    End With

    Dim utcSystemTime As SYSTEM_TIME

    If TzSpecificLocalTimeToSystemTime(timeZoneInfo, localSystemTime, utcSystemTime) <> 0 Then
        ToUniversalTime = SystemTimeToVBTime(utcSystemTime)
    Else
        err.Raise 1, "WINAPI", "Windows API call failed"
    End If

End Function

Private Function SystemTimeToVBTime(systemTime As SYSTEM_TIME) As Date
    With systemTime
        SystemTimeToVBTime = DateSerial(.wYear, .wMonth, .wDay) + _
                TimeSerial(.wHour, .wMinute, .wSecond)
    End With
End Function

- tomasdeml