Comment obtenir le datetime actuel en UTC à partir d'une macro VBA Excel

Est-il un moyen dans un fichier Excel macro VBA pour obtenir le courant datetime au format UTC?

Je peux appeler Now() pour obtenir l'heure actuelle dans le fuseau horaire local; est-il un générique façon à ensuite convertir ce à l'UTC?

Grâce

source d'informationauteur Jon

9

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

Il y a une macro sur cette page avec un LocalTimeToUTC méthode. Regarde comme il ferait l'affaire. Aussi quelques exemples de formules si vous voulez aller dans cette voie.

Modifier - un Autre lien. http://www.cpearson.com/excel/TimeZoneAndDaylightTime.aspx Cette page a plusieurs méthodes pour la date/l'heure. Choisissez votre poison. Soit devrait faire l'affaire, mais je pense que la deuxième est plus joli. 😉

Accordée à cette question est vieux, mais j'ai juste passé un peu de temps pour mettre en commun certaines de code propre sur cette base et je voulais le poster ici au cas où quelqu'un venir à travers cette page pourrait trouver utile.

Créer un nouveau Module dans le VBA Excel IDE (éventuellement en lui donnant un nom de UtcConverter ou quel que soit votre préférence peut être dans la Feuille de Propriétés) et le coller dans le code ci-dessous.

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

Si tous vous avez besoin est à l'heure actuelle, vous pouvez le faire avec Fonction getsystemtimece qui implique moins d'appels Win32. Il vous donne un temps de struct, avec une précision à la milliseconde, ce qui vous permet de formater comment vous souhaitez:

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

Utilisation:

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

Simplement, vous pouvez utiliser l'Objet COM pour parvenir à l'Heure UTC de l'Information.

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

Si vous avez également besoin de tenir compte de l'heure d'été, vous pouvez trouver le code suivant utiles:

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

0

Mon projet d'Accès fonctionne avec la plupart des tables d'Accès lié à MS SQL Server tables. C'est un DAO projet et j'ai eu de la difficulté à obtenir même une procédure stockée SQL avec GETUTCDATE() pour revenir en arrière. Mais la suite a été ma solution.
```
-- Create SQL table with calculated field for UTCDate
CREATE TABLE [dbo].[tblUTCDate](
[ID] [int] NULL,
[UTCDate]  AS (getutcdate())
) ON [PRIMARY]
GO
```
Créer une table Access, dbo_tblUTCDate, lié via ODBC à la table SQL tblUTCDate.

Créer une requête Access pour sélectionner à partir de la table Access. Je l'ai appelé qryUTCDate.
```
SELECT dbo_tblUTCDate.UTCDate FROM dbo_tblUTCDate
```
En 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
```

Vous devez vous connecter pour publier un commentaire.