先日、もり(@moripro3)さんのツイートに対して下記のような返信をしたので、例として簡単なサンプル用のコードを書くことにしました。
「端末の時間いじってやるぜー👻」なんて方がいないとも限らないので、どこかのサーバーやらAPIやらから日時取得というのも面白いかもしれません😉
— きぬあさ (@kinuasa) 2019年7月21日
NICTが公開しているAPIを使って、日本標準時(NHKや時報で使われている、いわゆる日本時間)を取得するVBAマクロです。
(以前どこかで書いたような気もするのですが、見つからなかったので新しく書き直しました。)
Option Explicit Public Sub Sample() Dim dt As Date dt = GetJST() If dt = CDate(0) Then Exit Sub MsgBox "現在の時刻は [" & Format(dt, "yyyy年m月d日 h時n分s秒") & "] です。", _ vbInformation + vbSystemModal, _ "日本標準時" End Sub Private Function GetJST() As Date 'NICTのサーバーから日本標準時取得 '※同一IPからのアクセスは1秒以上の間隔を空けること ' http://www.nict.go.jp/JST/http.html Dim js As String Dim d As Object, elm As Object Dim dt As Date Const api_url As String = "https://ntp-a1.nict.go.jp/cgi-bin/json" On Error Resume Next 'エラー処理は手抜き 'JSON取得 With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "GET", api_url, False .Send Select Case .Status Case 200: js = .ResponseText Case Else: GoTo Fin End Select End With 'JSONから日時取得 If Len(Trim(js)) < 1 Then GoTo Fin js = "(" & js & ")" '丸括弧で囲んでeval Set d = CreateObject("htmlfile") Set elm = d.createElement("span") elm.setAttribute "id", "result" d.body.appendChild elm d.parentWindow.execScript "document.getElementById('result').innerText = new Date(eval(" & js & ").st * 1000).toLocaleString();" If IsDate(elm.innerText) = True Then dt = CDate(elm.innerText) If Err.Number <> 0 Then GoTo Fin On Error GoTo 0 Fin: GetJST = dt End Function
仕組みは単純で、
APIからJSON取得
↓
JSONからサーバー時刻を抜き出し
↓
日付(Date)型として時刻取得
といった作業を行っています。
注意点としては、APIのガイドラインページにある通り、同一IPから連続してアクセスする場合、1秒以上の間隔を空ける必要があることです。
サーバーから日時を取得する方法としては、上記以外にも、例えば下記サイトで紹介されているような、サーバーのレスポンスヘッダー(Date)を使う方法もありますので、そのあたりはお好みで処理すれば良いかと思います。
2022/9/5 追記:
本記事のコードで利用しているAPIですが、2022年3月31日に提供が終了し、現在はNTPによる時刻配信に一元化されています。
下記サイトのようにNTPサーバーから時刻を取得することもできますが(下記サイトのコードはPowerShell)、VBAからとなると中々大変なので、日本のタイムゾーン(Asia/Tokyo)に対応している、NICTとは別のAPI(World Time API)から時刻を取得するコードを書いてみました。
Option Explicit Public Sub Sample() Dim dt As Date dt = GetJST() If dt = CDate(0) Then Exit Sub MsgBox "現在の時刻は [" & Format(dt, "yyyy年m月d日 h時n分s秒") & "] です。", _ vbInformation + vbSystemModal End Sub '-------------------------------------------------- ' WorldTimeAPIを使って日本の現在時刻取得 ' ※短時間での多数のリクエスト送信は禁止 ' ※正確さについては100%の精度保証無し ' ※詳細は下記公式サイト参照 ' http://worldtimeapi.org/pages/faqs '-------------------------------------------------- Private Function GetJST() As Date Dim dt As Date Const api_url As String = "https://worldtimeapi.org/api/timezone/Asia/Tokyo" Dim js As String On Error Resume Next With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "GET", api_url, False .Send Select Case .Status Case 200: js = .ResponseText End Select End With On Error GoTo 0 If Len(Trim(js)) > 0 Then js = "(" & js & ")" Dim d As Object, elm As Object Set d = CreateObject("htmlfile") Set elm = d.createElement("span") elm.setAttribute "id", "result" d.body.appendChild elm d.parentWindow.execScript "const dt = new Date(eval(" & js & ").datetime);document.getElementById('result').innerText = dt.getFullYear() + '/' + ('0' + (dt.getMonth() + 1)).slice(-2) + '/' + ('0' + dt.getDate()).slice(-2) + ' ' + ('0' + dt.getHours()).slice(-2) + ':' + ('0' + dt.getMinutes()).slice(-2) + ':' + ('0' + dt.getSeconds()).slice(-2);" If IsDate(elm.innerText) = True Then dt = CDate(elm.innerText) End If GetJST = dt End Function
公式サイトにも注意書きがある通り、NTPの替わりとなるものではなく、正確性が保証されたものではないですが、非常に便利なAPIです。
会社でExcelタイムカードの自作を行おうと考えて色々調べていましたが、このページの標準時の記載内容はとても参考になりました。ありがとうございます。
NICTは時刻をJSONで返すようなサービスはやめちゃったみたいですね。いまでも使える内容に更新する元気はありますか?
> のほほん 様
ブログ管理者のきぬあさです。
NICTの時刻配信はNTPに一元化されたため、別のAPIを利用したコードを追記しました。