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

Question

Excel VBA宏中是否有方法以UTC格式获取当前日期时间？

我可以拨打Now()获取当地时区的当前时间;有没有一种通用的方式然后将其转换为UTC？

感谢

Answer 1

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

有一个LocalTimeToUTC方法页面上的宏。看起来它会做的伎俩。还有一些公式示例，如果你想走这条路线。

编辑 - 另一个链接。 http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx这个页面有几种日期/时间的方法。选择你的毒药。要么伎俩，但我觉得第二个更漂亮。 ;）

Answer 2

授予此问题已过时，但我只是花了一些时间在此基础上整理一些干净的代码，我想在这里发布它，以防万一任何人遇到此页面可能会发现它有用。

在Excel VBA IDE中创建一个新模块（可选择给它起一个名称UtcConverter或您的首选项可以在属性表中）并粘贴到下面的代码中。

HTH

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 

Answer 3

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

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 

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. 

Answer 5

我访问项目与连接到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 

Answer 6

简单地说，你可以使用COM对象来实现UTC时间信息。

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