Excel VBAでUnix Timestamp(ミリ秒付き)を取得する。

Node.jsのnew Date().valueOf()で得られるUnixTimestampと同じ値をExcel VBAで取得する方法。
秒単位までは割と簡単なのだけどミリ秒単位までやるとめんどくさいという話。

↓こういう値をVBAで取得したい。

> new Date().valueOf()
1472735489962

色々ググってようやくこの形に落ち着きました。

Windows 7 Pro 32bit、Excel2010で検証済みです。(Excel2003でも動いた)

Option Explicit


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


Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)


Private Function GetMillisecond() As Long
    Dim tSystem As SYSTEMTIME
    On Error Resume Next
    GetSystemTime tSystem
    GetMillisecond = tSystem.wMilliseconds
End Function


' (参考)http://d.hatena.ne.jp/KuroNeko666/20070821/1187689020
Public Function GetUnixTimestampWithMilliseconds() As Variant
    Dim ut As Variant
'    ut = ((Now - 25569) * 86400) - (3600 * 9) ' "- (3600 * 9)"は日本の時差を差し引いている。
'    ut = ut * 1000
'    ut = ut + GetMillisecond
    ut = (((Now - 25569) * 86400) - (3600 * 9)) * 1000 + GetMillisecond

    GetUnixTimestampWithMilliseconds = ut
End Function


Private Sub Test()
    Debug.Print "(Node.js) new Date().valueOf() === ", GetUnixTimestampWithMilliseconds
End Sub