web-dev-qa-db-ja.com

ExcelVBAマクロからUTCで現在の日時を取得する方法

Excel VBAマクロで現在の日時をUTC形式で取得する方法はありますか？

Now()を呼び出して、ローカルタイムゾーンの現在の時刻を取得できます。これをUTCに変換する一般的な方法はありますか？

exceldatetimeexcel-vbatimezonevba
13
Jon

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

そのページには、LocalTimeToUTCメソッドを使用したマクロがあります。それがトリックをするように見えます。また、そのルートに行きたい場合は、いくつかの数式の例。

編集-別のリンク。 http://www.cpearson.com/Excel/TimeZoneAndDaylightTime.aspx このページには、日付/時刻のメソッドがいくつかあります。あなたの毒を選んでください。どちらでもうまくいくはずですが、2番目の方がきれいだと思います。 ;）

11
brad.huffman

簡単に言うと、COMオブジェクトを使用してUTC時間情報を取得できます。

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

確かにこの質問は古いですが、私はこれに基づいていくつかのクリーンなコードをまとめるのに少し時間を費やしました。このページに出くわした人が役立つと思う場合に備えて、ここに投稿したいと思いました。

ExcelVBAで新しいモジュールを作成します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
6
InteXX

必要なのが現在の時刻だけの場合は、 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.
4
user1454265

私のAccessプロジェクトは、主にMS SQLServerテーブルにリンクされたAccessテーブルで動作します。これはDAOプロジェクトであり、GETUTCDATE（）を使用してSQLsprocを返すのに問題がありました。しかし、以下が私の解決策でした。

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

ODBCを介してSQLテーブルtblUTCDateにリンクされたAccessテーブルdbo_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
0
skankyblackbird

夏時間も考慮する必要がある場合は、次のコードが役立つ場合があります。

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
tomasdeml