Office関連

日本標準時(JST)を取得するVBAマクロ

先日、もり(@moripro3)さんのツイートに対して下記のような返信をしたので、例として簡単なサンプル用のコードを書くことにしました。

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です。

【アイカツフレンズ!】ベストアイドル決定戦!2弾をプレイしてきたよ。前のページ

[Google Apps Script]スプレッドシートをExcelファイル(xlsx)に変換する次のページ

関連記事

  1. Office アドイン

    [Office用アプリ]日経ソフトウエア主催アプリ開発コンテストの案内

    2014/06/24 追記:コンテスト結果がWebで公開されました…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(H)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Office関連

    Google翻訳で文字列を翻訳するVBAマクロ(IE操作版)

    下記記事にあるように、ニューラルネット機械翻訳の導入によって、Goog…

  4. Office関連

    ZIP形式で圧縮・解凍を行うVBAマクロ

    この記事のように、処理の中でZIP形式のファイルを扱うことはありました…

  5. Office アドイン

    作業ウィンドウのアプリをWord 2013にも対応させる。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  6. Office関連

    Office製品の開発者用リファレンス(ダウンロード版)

    Docs.comでまとめていたリンクなんですが、来月15日にすべて廃止…

コメント

  • コメント (3)

  • トラックバックは利用できません。

    • たふあひ
    • 2020年 6月 21日 6:00am

    会社でExcelタイムカードの自作を行おうと考えて色々調べていましたが、このページの標準時の記載内容はとても参考になりました。ありがとうございます。

    • のほほん
    • 2022年 9月 04日 4:08pm

    NICTは時刻をJSONで返すようなサービスはやめちゃったみたいですね。いまでも使える内容に更新する元気はありますか?

    • > のほほん 様
      ブログ管理者のきぬあさです。
      NICTの時刻配信はNTPに一元化されたため、別のAPIを利用したコードを追記しました。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP