Jak uzyskać bieżącą datę i godzinę w UTC z makra programu Excel VBA

Question

Czy istnieje sposób w makrze programu Excel VBA, aby uzyskać bieżącą datę i godzinę w formacie UTC?

Mogę zadzwonić pod numer Now(), aby uzyskać aktualny czas w lokalnej strefie czasowej; czy istnieje ogólny sposób, aby przekonwertować to na UTC?

Dzięki

Answer 1

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

Jest makro na tej stronie z metodą LocalTimeToUTC. Wygląda na to, że to wystarczy. Także niektóre przykłady formuły, jeśli chcesz iść tą drogą.

Edytuj - kolejny link. http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx Ta strona ma kilka metod dla daty/czasu. Wybierz swoją truciznę. Albo powinienem załatwić sprawę, ale czuję, że druga jest ładniejsza. ;)

Answer 2

To pytanie jest stare, ale poświęciłem trochę czasu na napisanie jakiegoś czystego kodu na podstawie tego i chciałem go opublikować tutaj, na wypadek, gdyby ktokolwiek odwiedzający tę stronę mógł uznać to za użyteczne.

Utwórz nowy moduł w programie Excel VBA IDE (opcjonalnie podając nazwę w postaci UtcConverter lub dowolne inne preferencje w arkuszu właściwości) i wklej poniższy kod.

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

Jeśli trzeba także uwzględnić czas letni, można znaleźć następujący kod przydatne:

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

Jeśli wszystko czego potrzebujesz to aktualny czas, można zrobić to z GetSystemTime, który obejmuje mniej wywołań Win32. To daje struct czasu, z dokładnością do milisekund, które można sformatować, jak chcesz:

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 

Zastosowanie:

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

Mój projekt Dostęp współpracuje z większości stołów dostępowych powiązanych z MS SQL Server tabele. Jest to projekt DAO i miałem problemy z uzyskaniem sproc SQL z GETUTCDATE(), aby wrócić. Ale to było moje rozwiązanie.

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

Utwórz tabelę dostępu, dbo_tblUTCDate, połączoną przez ODBC z tabelą tblUTCDate tabeli SQL.

Utwórz zapytanie dostępu, aby wybrać z tabeli dostępu. Nazwałem to qryUTCDate.

SELECT dbo_tblUTCDate.UTCDate FROM dbo_tblUTCDate 

w 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

Wystarczy, można użyć obiektu COM osiągnąć UTC Time Information.

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