如何从Excel VBAmacros获取UTC中的当前date时间

有没有办法在Excel VBAmacros中获取UTC格式的当前date时间?

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

谢谢

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

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

编辑 – 另一个链接。 http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx这个页面有几个date/时间的方法。 select你的毒药。 要么伎俩,但我觉得第二个更漂亮。 ;)

当然这个问题已经很老了,但是我只是花了一些时间把基于这个的干净的代码放在一起,我想在这里发布它,以防万一有人遇到这个页面可能会觉得它有用。

在Excel VBA IDE中创build一个新的模块(可选地给它一个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 

如果你所需要的只是当前时间,你可以用GetSystemTime来做到这一点,它涉及的Win32调用较less。 它给你一个时间结构,毫秒精度,你可以设置你的喜好:

 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. 

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

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

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

 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 

我的Access项目主要与链接到MS SQL Server表的Access表一起使用。 这是一个DAO项目,我甚至无法使用GETUTCDATE()返回SQL sproc。 但以下是我的解决scheme。

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

创build一个Access表,dbo_tblUTCDate,通过ODBC链接到SQL表tblUTCDate。

创build一个Access查询来从Access表中进行select。 我把它叫做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