Google Calendar APIを使って日本の祝日を取得するVBAマクロ

ホーム
Office関連, Excel
Google Calendar APIを使って日本の祝日を取得するVBAマクロ

Office関連

2017.10.31

Google Calendar APIを使って日本の祝日を取得するVBAマクロ

祝日の一覧を用意する必要があったので、Google Calendar APIを使って日本の祝日を取得するマクロを考えてみました。

APIキーの作成

Calendar APIを利用するに当たり、まずは必要となるAPIキーを用意します。

Google Cloud Consoleを開き、Google アカウントでログインします。
プロジェクトの選択画面から「プロジェクトを作成」ボタンをクリックします。

新しいプロジェクト画面が表示されるので、プロジェクト名を入力し、「作成」ボタンをクリックします。

しばらく待つとプロジェクトが作成されるので、プロジェクトの選択画面から作成したプロジェクトを開きます。

「APIとサービス」から「ライブラリ」を開きます。

「Google Calendar API」を選択し、「有効にする」ボタンをクリックします。

「認証情報を作成」ボタンをクリックします。

プロジェクトへの認証情報の追加画面が表示されますが、「API キー」をクリックしてこの手順をスキップします。

API キー画面が表示されるので、「作成」ボタンをクリックしてAPIキーを作成します。

作成されたAPIキーをコピーして、メモ帳等のテキストエディタに貼り付けておきます。

Google Calendar APIを使って日本の祝日を取得するマクロ

※下記コードはScriptControlを使用しているため、64ビット版Officeでは動作しません。
※コード中の「ApiKey」の値は、上記手順で取得したAPIキーに置き換えてください。

Option Explicit

Private Sub GetHolidaysFromGoogleCalendar()
'Google Calendar APIを使って日本の祝日を取得
  Dim url As String
  Dim js As String
  Dim summary As String, start_date As String
  Dim items As Object, item As Object
  Dim jso_start As Object
  Dim i As Long
  
  '--------------------------------------------------
  '※必要に応じて変更
  '--------------------------------------------------
  Const TargetYear As String = "2018" '祝日を取得する年
  Const CalendarId As String = "ja.japanese#holiday@group.v.calendar.google.com"
  Const ApiKey As String = "(取得したAPIキー)"
  '--------------------------------------------------
  
  url = "https://www.googleapis.com/calendar/v3/calendars/" & _
        EncodeURL(CalendarId) & _
        "/events?orderBy=startTime&singleEvents=true" & _
        "&timeMin=" & EncodeURL(TargetYear & "-1-1T00:00:00+09:00") & _
        "&timeMax=" & EncodeURL(TargetYear & "-12-31T00:00:00+09:00") & _
        "&key=" & ApiKey
  
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url, False
    .Send
    Select Case .Status
      Case 200: js = .ResponseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  
  i = 1 '初期化
  js = "(" & js & ")"
  With CreateObject("ScriptControl")
    .Language = "JScript"
    Set items = CallByName(.CodeObject.eval(js), "items", VbGet)
  End With
  With ActiveSheet
    For Each item In items
      Set jso_start = CallByName(item, "start", VbGet)
      start_date = CallByName(jso_start, "date", VbGet)
      summary = CallByName(item, "summary", VbGet)
      .Cells(i, 1).Value = start_date
      .Cells(i, 2).Value = summary
      i = i + 1
    Next
  End With
End Sub

Private Function EncodeURL(ByVal Target As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(Target)
  End With
End Function

上記コードを実行すると、選択中のシートに、指定した年の祝日が書きこまれます。