VBAからkintoneデータをOAuth2.0認証で読み書きする - 準備編

GoogleやMicrosoftなど大手の開発環境を提供しているサイトでは、現在アプリケーションからのアクセス認証は「OAuth2.0認証」が当たり前になってきています。Kintoneでも2018年11月頃からOAuth2.0認証が装備されていますが、ネット上を探ってみると、どうもKintoneユーザが広くこの方式を使っていると思われるものが殆ど無い。

古いIDとPASSを利用したアクセス方式のものばかりで、ちょっとどうかなと。という事で、Excel VBAでKintoneのOAuth2.0認証を実行し、取得したAccess Tokenを持ってしてレコードの操作をしてみようと思います。

※今回は準備編なので、OAuth2.0認証周りを装備します。

今回使用するファイル等

新方式が登場しました

IE11の廃止に伴い、SeleniumやNode.jsやらといった手段を使わず、またPuppeteerと同様の手法(CDPを叩く)でVBAとEdge/ChromeのみでOAuth2.0認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。

VBAでOAuth2.0認証 - 新方式を試してみた

事前準備

これまでのIDとPASSを利用した認証とは違い、OAuth2.0認証の為には其のための情報とデータを作成しておく必要性があります。また、Excelでより安全にこれらの情報を格納しておく手段も装備しておくべきでしょう。

OAuth2.0認証情報を作成する

まずは、OAuth2.0認証に必要な情報を作成しておきます。以下の手順で作成しておきましょう。

  1. 自分のドメインのkintone管理画面を開く(例:https://domainname.cybozu.com/)
  2. Cybozu共通管理をクリックする
  3. システム管理⇒外部連携をクリックする
  4. 下のほうにある「OAuthクライアントの追加」をクリックする
  5. クライアント名は適当に入力
  6. リダイレクトエンドポイントは、認証後に表示するウェブページを指定。自社のウェブサイトURLやhttp://localhostで良いかと思います。
  7. 保存をクリック
  8. 連携利用ユーザの設定をクリック
  9. OAuth2.0認証を許可するユーザにチェックを入れて保存をクリックします。
  10. 再度、作ったクライアント名の行にある✏マークをクリックして、4.の編集画面を出します。
  11. すると、クライアントIDクライアントシークレット認可エンドポイントトークンエンドポイントが出てくるので、これをメモって置きます。クライアントシークレットは絶対に流出させないように注意が必要です。
  12. これで認証用の情報を取得することができました。

図:認証情報を取得しておきましょう

Postmanで確認する

取得した認証情報を元に、実際にAccess Tokenが取得できるかどうかテストする必要があります。ここでは開発者ではよく利用される「Postman」を使って、認証を取得してみましょう。事前にPostmanをインストールしておいてください(Chrome AppのPostmanDeprecatedになりましたので注意)。

  1. Postmanを起動します。
  2. Start Something Newのページでは、Create a Requestをクリックします。
  3. Authorizationをクリックします
  4. Typeでは、OAuth2.0を選択。Get New Access Tokenをクリックします。
  5. Token Nameは適当に入力
  6. Callback URLには、リダイレクトエンドポイントのURLを入力します。
  7. Auth URLには、認可エンドポイントのURLを入力します。
  8. Access Token URLには、トークンエンドポイントのURLを入力します。
  9. Client IDおよびClient Secretにはそれぞれ、クライアントIDおよびクライアントシークレットを入力
  10. Scopeは与えるkintoneのスコープを設定。今回は読み取りだけのk:app_record:readを入力(登録、更新、削除をさせたいのであれば、k:app_record:writeを指定)。複数指定する場合は、半角スペースで区切ってつなげれば良い。
  11. Stateは適当な文字列を入れておきます。CSRF対策の為の仕組みです。
  12. Request Tokenをクリックする
  13. kintoneのログイン画面が出てくるので、連携利用ユーザでチェックを入れたアカウントでログインします。
  14. 許可しますか?という問い合わせ画面が出るので、許可をクリック
  15. Manage Access Tokensの情報が出てきます。これでAccess Tokenを取得出来ました。ここでは、refresh_tokenの値やexpire_inの値も入っています。これをプログラムからはbearerで認証させることになります。
  16. Use Tokenをクリックすると、Access Tokenに値が入ります。これを元に、続けてPostman上でレコードの取得テストなども実施可能です。
  17. 認証コードのexpire_inはおよそ10分間、Access Tokenの場合60分で失効します。

図:Postmanに認証用情報を入力していく

図:認証結果の情報

Excelで情報を格納する手段を作っておく

UIの作成と準備

Excel側でこれらの認証用情報を格納する手段と入力用UIを用意しておくべきでしょう。今回はUserFormを使って、レジストリにデータを保存する仕組みを利用します。またセンシティブな情報を扱うので、クライアントシークレットに関してはAES128bitで暗号化した状態で保存するようにします。

※事前にAES128bitで暗号化するというサイトを参照して、クラスや標準モジュールをプロジェクトに追加しておく必要があります。 enckeyやencivは必ず指定桁数でランダムなものを利用しましょう。

  1. UserForm1をプロジェクトに作成する
  2. 基本サブドメイン、リダイレクトURL、クライアントIDおよびクライアントシークレットの4項目があれば十分です。
  3. クライアントシークレットは暗号化しますし、入力画面では*で表示するように初期化が必要です。
  4. 起動時にクライアントシークレットは復号化してテキストボックスに表示します。
  5. データの保存先はレジストリになります。よって、違うPCや違うアカウントの場合、再度登録が必要になります。
  6. Access TokenやRefresh Tokenについてもレジストリに暗号化して保存することになります。
  7. サブドメインとは、ログインURLにあるhttps://サブドメイン.cyboze.comのURLにある文字列です。

図:こんな感じの入力UIを装備する

ソースコード

初期化と保存時のコードになります。

Private Sub CommandButton1_Click()
    '入力内容を取得する
    Dim apikey As String
    Dim apitoken As String
    Dim subdomain As String
    Dim redirect As String
    Dim userid As String
    Dim regpass As String
    Dim lRet As Variant

    subdomain = Me.TextBox3.Value
    redirect = Me.TextBox4.Value
    userid = Me.TextBox5.Value
    regpass = Me.TextBox6.Value

    '入力内容でもってレジストリにデータを登録
    lRet = RegSetValue(HKEY_CURRENT_USER, _
           "Software\kintoneman" & _
           "\Settings", _
           "subdomain", _
           REG_SZ, _
           subdomain)

    lRet = RegSetValue(HKEY_CURRENT_USER, _
           "Software\kintoneman" & _
           "\Settings", _
           "redirect", _
           REG_SZ, _
           redirect)

    lRet = RegSetValue(HKEY_CURRENT_USER, _
           "Software\kintoneman" & _
           "\Settings", _
           "userid", _
           REG_SZ, _
           userid)
    
    lRet = RegSetValue(HKEY_CURRENT_USER, _
           "Software\kintoneman" & _
           "\Settings", _
           "kinpass", _
           REG_SZ, _
           aes128encode(regpass))
    
    'フォームを閉じる
    Unload UserForm1
    
End Sub


'UserFormがロードされた時に発動
Private Sub UserForm_Initialize()
    'レジストリ項目をボックスにロードする
    On Error Resume Next
    
    'パスワード入力欄を*に変換する
    TextBox6.PasswordChar = "*"
    TextBox6.TextAlign = fmTextAlignLeft
    
    'レジストリからID等を読み取る
    Dim subdomain As String
    Dim userid As String
    Dim regpass As String
    Dim redirect As String
    
    subdomain = RegGetValue(HKEY_CURRENT_USER, _
            "Software\kintoneman" & _
            "\Settings", _
            "subdomain", _
            REG_SZ, _
            0)

    userid = RegGetValue(HKEY_CURRENT_USER, _
            "Software\kintoneman" & _
            "\Settings", _
            "userid", _
            REG_SZ, _
            0)
    
    redirect = RegGetValue(HKEY_CURRENT_USER, _
            "Software\kintoneman" & _
            "\Settings", _
            "redirect", _
            REG_SZ, _
            0)
            
    Me.TextBox3.Value = subdomain
    Me.TextBox4.Value = redirect
    Me.TextBox5.Value = userid

    'レジストリのパスワードを復号化して取り出す
    regpass = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "kinpass", _
                REG_SZ, _
                0)
    
    
    Me.TextBox6.Value = aes128decode(regpass)

End Sub
  • UserFormのinitializeにて、テキストボックスにPasswordCharを設定する事でパスワード入力用テキストボックスになります。
  • aes128decodeで復号化、aes128encodeにて暗号化をしています。

ソースコード

認証周りの実装

認証にはInternet Explorerを使う古い手を利用します。ただし、64bit環境の場合には問題が発生する可能性もあるので、対処が必要になります。以下のコードは32bit/64bit両方のOfficeで動作します。

ソースコード

'OAuth認証用
Private Const oauthurl As String = "ここに認可エンドポイントURLを?付きで入れる"
Private Const tokenurl As String = "ここにトークンエンドポイントURLを入れる"
Private Const grant_type As String = "authorization_code"
Private Const scope As String = "k:app_record:write"  '読み書き更新の権限を与える
Public client_id As String
Public client_secret As String
Public redirecturl As String

'プロキシURL(社内で利用時)
Public Const proxyuri As String = "ここにプロキシーのアドレスを入れる"

'Sleep用
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

'Boxで認証コードを実行する
Public Function kintoneAuthorization()
    '-- IE を起動する
    Dim objBrowser As Object
    Set objBrowser = CreateObject("InternetExplorer.Application")
    Const READYSTATE_COMPLETE = 4
    
    '変数を宣言する
    Dim tempurl As String
    Dim authcode As String
    Dim tokenflg As Boolean
    
    'レジストリから必要な情報を取得しておく
    Dim tempsecret As String
    
    redirecturl = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "redirect", _
                REG_SZ, _
                0)

    client_id = RegGetValue(HKEY_CURRENT_USER, _
            "Software\kintoneman" & _
            "\Settings", _
            "userid", _
            REG_SZ, _
            0)
    
    tempsecret = RegGetValue(HKEY_CURRENT_USER, _
                    "Software\kintoneman" & _
                    "\Settings", _
                    "kinpass", _
                    REG_SZ, _
                    0)
                    
    client_secret = aes128decode(tempsecret)
    
    
    With objBrowser
        '-- IEを表示
        .Visible = True

        '-- 表示位置を設定
        .Top = 100  'Y位置(上下)
        .Left = 200  'X位置(左右)
        .Height = 800  'IEウィンドウの高さ
        .Width = 650 'IEウィンドウの幅
        
        'その他の設定
        .AddressBar = False
        .MenuBar = False
        .StatusBar = False
        .Toolbar = False

        '-- 認証画面を表示
        Dim url As String
        url = oauthurl & "client_id=" & client_id & "&redirect_uri=" & redirecturl & "&state=authenticated&response_type=code&scope=" & scope
        .Navigate url

        '-- IEが表示されるまで待機
        On Error Resume Next
        Do While .Busy = True Or .ReadyState <> 4
            DoEvents
        Loop
        
        '認証が実行されるまで待機
        While .Busy Or _
              .ReadyState <> READYSTATE_COMPLETE Or _
              InStr(LCase(.LocationURL), redirecturl) < 1
            DoEvents
        Wend
        
        '7秒間sleepさせる(Windows10対策)
        Sleep 7000
        
        'URLの値を取得する
        tempurl = objBrowser.LocationURL
        
        'ログアウトさせる
        While .Busy Or .ReadyState <> READYSTATE_COMPLETE
          DoEvents
        Wend
        .Quit
    End With
    
    '認証用コードを取得する
    authcode = Mid(tempurl, InStr(tempurl, "code=") + 5)    'code=以下をURLから取得する
    authcode = Replace(authcode, "&state=authenticated", "")    '余計な文字列を消す

    'Access Tokenを取得する
    tokenflg = getAccessToken(authcode)
    
    '終了処理
    If tokenflg = True Then
        'Access Tokenを取得できた
        MsgBox "認証が完了しました。"
        Exit Function
    Else
        'Access Token取得失敗
        MsgBox "認証は失敗しましたよ!!残念ながら!"
        Exit Function
    End If
    
End Function

'認証コードを持ってPOST通信でアクセストークンを取得する
Public Function getAccessToken(authcode As String) As Boolean
    '変数を宣言する
    Dim JsonObject As Object, item As Object
    Dim strRes As Variant
    Dim dat As Variant
    Dim lRet As Variant

    'JSONをパースする用の変数
    Dim doc, jsn
    Dim access_token As String
    Dim refresh_token As String
    Dim expire_in As Integer
    Dim ExpireDate As Variant
    
    'JSON受信用
    'HTMLDocumentを取得
    Set doc = CreateObject("HtmlFile")
    'scriptタグを追加
    doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
    
    '送信データを組み立て
    dat = "grant_type=" & grant_type & _
        "&redirect_uri=" & redirecturl & _
        "&code=" & authcode & _
        "&client_id=" & client_id & _
        "&client_secret=" & client_secret

    'POST通信でAPIを叩いてデータを取得
    With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "POST", tokenurl, False
      .setProxy 2, proxyuri  'プロキシサーバつかってない場合はコメントアウト
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .send dat
      
      '返ってきた値をもとにデータを処理
      Dim status As String
      status = .status
        
      '200が返ってきたらAccess Tokenを取り出す
      Select Case status
        Case 200
            'JSONデータを取得する
            Json = .responseText
            
            If Len(Trim(Json)) > 0 Then
                'パース関数でJSONオブジェクトを取得
                Set jsn = doc.JsonParse(Json)
                
                'Token情報を取得する
                access_token = jsn.access_token
                refresh_token = jsn.refresh_token
                expire_in = jsn.expires_in
                ExpireDate = DateAdd("s", expire_in, Now())
                
                'レジストリにデータを登録
                lRet = RegSetValue(HKEY_CURRENT_USER, _
                       "Software\kintoneman" & _
                       "\Settings", _
                       "expiredate", _
                       REG_SZ, _
                       ExpireDate)
            
                lRet = RegSetValue(HKEY_CURRENT_USER, _
                       "Software\kintoneman" & _
                       "\Settings", _
                       "access_token", _
                       REG_SZ, _
                       aes128encode(access_token))
                
                lRet = RegSetValue(HKEY_CURRENT_USER, _
                       "Software\kintoneman" & _
                       "\Settings", _
                       "refresh_token", _
                       REG_SZ, _
                       aes128encode(refresh_token))

                '値を返す
                getAccessToken = True
            
            Else
                getAccessToken = False
            End If
          
        Case Else
            getAccessToken = False
      End Select
    End With
    
End Function
  • 基本的には以前作成したVBAからBox APIを叩いてみる – 準備編のコードを流用しています。
  • oauthurlのURLの最後は?でなければならないので注意
  • ただし、認証用コードを取得する部分だけは余計な文字列がついていたりするので、replaceをつかって調整しています。
  • 実行すると、IEが起動し、kintoneのログイン画面が出る。ログイン成功し許可を与えると認証用コードがURLのcode=以下についてくるので、これを取得し、getAccessTokenに渡してる
  • setProxyはプロキシーサーバを超える為の設定です。使っていない場合にはコメントアウトしておきましょう。
  • access_tokenrefresh_tokenは重要なコードなのでAES128bitで暗号化してレジストリに保存しておきます。

図:OAuth2.0認証ログインの画面

64bit対応

Microsoft Office 64bit版およびInternet Explorer 11 64bit版の場合、認証コードを取得出来なかったり、また取得できてもIEが閉じられなかったり非常に面倒な事に遭遇します。とくにIEの64bit版など殆ど意味のない存在なので、以下の設定をしておいて、32bit版が起動するように修正しておきましょう。

  1. インターネットオプションを起動する
  2. 詳細設定タブをクリックする
  3. 拡張保護モードで64bitプロセッサを有効にするのチェックを外す
  4. 拡張保護モードを有効にするのチェックを外す
  5. これでコードを実行してみる。32bit版IE11なので問題なく動くはず。

この作業を各クライアントでやってもらうというのも不毛なので、レジストリを操作するモジュールを利用して、VBAからセットしてやる方法がスマートです。以下のコードでこの2つの設定を無効化する事が可能です。

'IEの拡張保護モードおよび64bit設定を無効にする
Call RegSetValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Isolation64Bit", REG_DWORD, 0)
Call RegSetValue(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Isolation", REG_SZ, "PMIL")

本コードでは、IE11 64bit版ですと、kintoneAuthorization()にて問題がでます。問題の箇所はInternet Explorerのobject生成時にあり、以下のようなエラーが出ます。64bitのままNew InternetExplorerMediumを使う手法もあるのですが、こちらはIE11を閉じる事が出来なくなります。

図:こんな感じのエラーがBusyやreadystateのあたりで出る。

Access Tokenが期限切れかどうかチェックする

取得したAccess Tokenは60分で失効するような仕様になっています(OAuth2.0認証全般でこのような仕様です)。そのため、タイミングが悪いとKintone API実行時に失効してしまい、再度Access Tokenの為に認証と取得を実行しなければならないのは、非常に手間です。

そこで利用するのがRefresh Token。期限切れかどうかをチェックし切れていると判断した場合にはAccess Tokenをバックエンドで自動再取得させて、APIをスムーズに実行するようにしてあげましょう。

'Access Tokenが認証切れかどうかをチェックする
'checkflgが0=OK, 1=失効
Public Function checkExpireToken() As Integer
    'チェックフラグ
    Dim checkflg As Integer

    '60分オーバーチェック
    Dim checkday As Variant
    Dim expire_in As Variant
    Dim expireday As Variant

    expire_in = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "expiredate", _
                REG_SZ, _
                0)

    expireday = DateDiff("n", Now(), expire_in)

    'Access Tokenがexpireしているかどうかをチェック(10分以下)
    If expireday <= 10 Then
        'expireする日付まで10分以下の場合
        checkflg = 1
    Else
        'Access Tokenはまだ生きてるので問題ナシ
        checkflg = 0
    End If

    'フラグを返す
    checkExpireToken = checkflg

End Function
  • expire_inには60分後の失効時間が入っています。
  • DateDiffで現在時刻との分の差を取得し、10分以下であるならば、checkflgを1にしてRefresh Tokenで再取得をさせるようにしています。
  • 関数を実行するだけで、結果がわかるので、この返り値を元に次のRefresh TokenでToken再取得のコードを実装すると良いでしょう。

Refresh Tokenで新しいAccess Tokenを取得する

'refresh tokenを持って新しいAccess Tokenを取得する
Public Function getNewToken() As Boolean
    '変数を宣言する
    Dim JsonObject As Object, item As Object
    Dim strRes As Variant
    Dim dat As Variant
    Dim tempflg As Boolean

    'JSONをパースする用の変数
    Dim doc, jsn
    Dim access_token As String
    Dim refresh_token As String
    Dim expire_in As Integer
    
    'JSON受信用
    'HTMLDocumentを取得
    Set doc = CreateObject("HtmlFile")
    'scriptタグを追加
    doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
    
    'リフレッシュトークンの取り出し
    Dim tempreg As String
    Dim reftoken As Variant
    tempreg = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "refresh_token", _
                REG_SZ, _
                0)
    
    reftoken = aes128decode(tempreg)
    
    'Client IDとClient Secretの取り出し
    client_id = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "userid", _
                REG_SZ, _
                0)
    
    tempreg = RegGetValue(HKEY_CURRENT_USER, _
                "Software\kintoneman" & _
                "\Settings", _
                "kinpass", _
                REG_SZ, _
                0)
    
    client_secret = aes128decode(tempreg)
    
    'リクエストbodyを組み立て
    dat = "grant_type=refresh_token" & _
        "&refresh_token=" & reftoken & _
        "&client_id=" & client_id & _
        "&client_secret=" & client_secret

    'POST通信でAPIを叩いてデータを取得
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", tokenurl, False
        .setProxy 2, proxyuri  'プロキシサーバつかってない場合はコメントアウト
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send dat
        
        '返ってきた値をもとにデータを処理
        Dim status As String
        status = .status
          
      '200が返ってきたらAccess Tokenを取り出す
      Select Case status
        Case 200
            'JSONデータを取得する
            Json = .responseText
            
            If Len(Trim(Json)) > 0 Then
                'パース関数でJSONオブジェクトを取得
                Set jsn = doc.JsonParse(Json)
                
                'Token情報を取得する
                'ただし、refresh_tokenは別途返っては来ない仕様のようだ
                access_token = jsn.access_token
                'refresh_token = jsn.refresh_token
                expire_in = jsn.expires_in
                
                '60分後のexpiredateを格納する
                ExpireDate = DateAdd("s", expire_in, Now())
                
                'レジストリにデータを登録
                lRet = RegSetValue(HKEY_CURRENT_USER, _
                       "Software\kintoneman" & _
                       "\Settings", _
                       "expiredate", _
                       REG_SZ, _
                       ExpireDate)
            
                lRet = RegSetValue(HKEY_CURRENT_USER, _
                       "Software\kintoneman" & _
                       "\Settings", _
                       "access_token", _
                       REG_SZ, _
                       aes128encode(access_token))

                '値を返す
                tempflg = True
            
            Else
                tempflg = False
            End If
          
        Case Else
             tempflg = False
      End Select
    End With

    '値を返す
    getNewToken = tempflg
End Function
  • ほぼAccess Tokenを取得するコードと同じですが、dat変数の中でgrant_typeでrefresh tokenを指定しています。
  • 他のOAuth2.0認証と違い、新しいAccess Tokenは取得できますが、新しいRefresh Tokenは返ってこない仕様(つまり使い回す)ようだ。

関連リンク

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)