Is there a way in an Excel VBA macro to get the current datetime in UTC format?
I can call Now()
to get the current time in the local timezone; is there a generic way to then convert开发者_运维问答 this to UTC?
Simply, you can use COM Object to achieve UTC Time Information.
Dim dt As Object, utc As Date
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
utc = dt.GetVarDate(False)
http://excel.tips.net/Pages/T002185_Automatically_Converting_to_GMT.html
There is a macro on that page with a LocalTimeToUTC method. Looks like it would do the trick. Also some formula examples if you wanted to go that route.
Edit - Another link. http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx This page has several methods for date/time. Pick your poison. Either should do the trick, but I feel like the second is prettier. ;)
Granted this question is old, but I just spent some time putting together some clean code based on this and I wanted to post it here in case anyone coming across this page might find it useful.
Create a new Module in the Excel VBA IDE (optionally giving it a name of UtcConverter
or whatever your preference may be in the Properties Sheet) and paste in the code below.
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
If all you need is the current time, you can do this with GetSystemTime, which involves fewer Win32 calls. It gives you a time struct, with millisecond precision, which you can format how you'd like:
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
Usage:
Dim nowUtc As SYSTEMTIME
Call GetSystemTime(nowUtc)
' nowUtc is now populated with the current UTC time. Format or convert to Date as needed.
Sigh. The question is about Excel VBA, NOT about "Excel VBA for Windows". In short, none of the answers, however upvoted they may be, works on a Mac or on Linux (yes, Office, at least Office 2000, runs on Linux too)
So here is my answer. It's predictible it gets zero vote, but truth is not a beauty contest.
For Windows, see the other answers (those that silently assume Windows, demonstrating how programmers create problems by assuming things).
For the Mac, see https://macscripter.net/viewtopic.php?id=41117.
For Linux, see How do I get GMT time in Unix?
Have fun with VBA. Sorry to be so dry, but there's so much approximation going arround, S.O. gets scary now.
If you also need to account for daylight saving time, you may find the following code useful:
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
My Access project works with mostly Access tables linked to MS SQL Server tables. It is a DAO project and I was having trouble even getting a SQL sproc with GETUTCDATE() to come back. But following was my solution.
-- Create SQL table with calculated field for UTCDate
CREATE TABLE [dbo].[tblUTCDate](
[ID] [int] NULL,
[UTCDate] AS (getutcdate())
) ON [PRIMARY]
GO
Create an Access table, dbo_tblUTCDate, linked via ODBC to the SQL table tblUTCDate.
Create an Access query to select from the Access table. I called it qryUTCDate.
SELECT dbo_tblUTCDate.UTCDate FROM dbo_tblUTCDate
In 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
精彩评论