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認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。
事前準備
これまでのIDとPASSを利用した認証とは違い、OAuth2.0認証の為には其のための情報とデータを作成しておく必要性があります。また、Excelでより安全にこれらの情報を格納しておく手段も装備しておくべきでしょう。
OAuth2.0認証情報を作成する
まずは、OAuth2.0認証に必要な情報を作成しておきます。以下の手順で作成しておきましょう。
- 自分のドメインのkintone管理画面を開く（例：https://domainname.cybozu.com/）
- Cybozu共通管理をクリックする
- システム管理⇒外部連携をクリックする
- 下のほうにある「OAuthクライアントの追加」をクリックする
- クライアント名は適当に入力
- リダイレクトエンドポイントは、認証後に表示するウェブページを指定。自社のウェブサイトURLやhttp://localhostで良いかと思います。
- 保存をクリック
- 連携利用ユーザの設定をクリック
- OAuth2.0認証を許可するユーザにチェックを入れて保存をクリックします。
- 再度、作ったクライアント名の行にある✏マークをクリックして、4.の編集画面を出します。
- すると、クライアントID、クライアントシークレット、認可エンドポイント、トークンエンドポイントが出てくるので、これをメモって置きます。クライアントシークレットは絶対に流出させないように注意が必要です。
- これで認証用の情報を取得することができました。
図：認証情報を取得しておきましょう
Postmanで確認する
取得した認証情報を元に、実際にAccess Tokenが取得できるかどうかテストする必要があります。ここでは開発者ではよく利用される「Postman」を使って、認証を取得してみましょう。事前にPostmanをインストールしておいてください（Chrome AppのPostmanはDeprecatedになりましたので注意）。
- Postmanを起動します。
- Start Something Newのページでは、Create a Requestをクリックします。
- Authorizationをクリックします
- Typeでは、OAuth2.0を選択。Get New Access Tokenをクリックします。
- Token Nameは適当に入力
- Callback URLには、リダイレクトエンドポイントのURLを入力します。
- Auth URLには、認可エンドポイントのURLを入力します。
- Access Token URLには、トークンエンドポイントのURLを入力します。
- Client IDおよびClient Secretにはそれぞれ、クライアントIDおよびクライアントシークレットを入力
- Scopeは与えるkintoneのスコープを設定。今回は読み取りだけのk:app_record:readを入力（登録、更新、削除をさせたいのであれば、k:app_record:writeを指定）。複数指定する場合は、半角スペースで区切ってつなげれば良い。
- Stateは適当な文字列を入れておきます。CSRF対策の為の仕組みです。
- Request Tokenをクリックする
- kintoneのログイン画面が出てくるので、連携利用ユーザでチェックを入れたアカウントでログインします。
- 許可しますか？という問い合わせ画面が出るので、許可をクリック
- Manage Access Tokensの情報が出てきます。これでAccess Tokenを取得出来ました。ここでは、refresh_tokenの値やexpire_inの値も入っています。これをプログラムからはbearerで認証させることになります。
- Use Tokenをクリックすると、Access Tokenに値が入ります。これを元に、続けてPostman上でレコードの取得テストなども実施可能です。
- 認証コードのexpire_inはおよそ10分間、Access Tokenの場合60分で失効します。
図：Postmanに認証用情報を入力していく
図：認証結果の情報
Excelで情報を格納する手段を作っておく
UIの作成と準備
Excel側でこれらの認証用情報を格納する手段と入力用UIを用意しておくべきでしょう。今回はUserFormを使って、レジストリにデータを保存する仕組みを利用します。またセンシティブな情報を扱うので、クライアントシークレットに関してはAES128bitで暗号化した状態で保存するようにします。
※事前にAES128bitで暗号化するというサイトを参照して、クラスや標準モジュールをプロジェクトに追加しておく必要があります。 enckeyやencivは必ず指定桁数でランダムなものを利用しましょう。
- UserForm1をプロジェクトに作成する
- 基本サブドメイン、リダイレクトURL、クライアントIDおよびクライアントシークレットの4項目があれば十分です。
- クライアントシークレットは暗号化しますし、入力画面では*で表示するように初期化が必要です。
- 起動時にクライアントシークレットは復号化してテキストボックスに表示します。
- データの保存先はレジストリになります。よって、違うPCや違うアカウントの場合、再度登録が必要になります。
- Access TokenやRefresh Tokenについてもレジストリに暗号化して保存することになります。
- サブドメインとは、ログインURLにあるhttps://サブドメイン.cyboze.comのURLにある文字列です。
図：こんな感じの入力UIを装備する
ソースコード
初期化と保存時のコードになります。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 |
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で動作します。
ソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 |
'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_tokenとrefresh_tokenは重要なコードなのでAES128bitで暗号化してレジストリに保存しておきます。
図：OAuth2.0認証ログインの画面
64bit対応
Microsoft Office 64bit版およびInternet Explorer 11 64bit版の場合、認証コードを取得出来なかったり、また取得できてもIEが閉じられなかったり非常に面倒な事に遭遇します。とくにIEの64bit版など殆ど意味のない存在なので、以下の設定をしておいて、32bit版が起動するように修正しておきましょう。
- インターネットオプションを起動する
- 詳細設定タブをクリックする
- 拡張保護モードで64bitプロセッサを有効にするのチェックを外す
- 拡張保護モードを有効にするのチェックを外す。
- これでコードを実行してみる。32bit版IE11なので問題なく動くはず。
この作業を各クライアントでやってもらうというのも不毛なので、レジストリを操作するモジュールを利用して、VBAからセットしてやる方法がスマートです。以下のコードでこの２つの設定を無効化する事が可能です。
|
1 2 3 |
'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をスムーズに実行するようにしてあげましょう。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
'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を取得する
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
'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は返ってこない仕様（つまり使い回す）ようだ。
関連リンク
- 【VBA】ユーザーフォームでパスワード入力画面をつくる
- ExcelVBAでAES128bitでの暗号化・復号をやってみる
- 【VBA】ユーザーフォームでパスワード入力画面をつくる
- VBAからBoard APIを使ってデータの入出力してみた
- kintoneとExcelを連携するためのVBAクラスを作りました！
- Kinton API - Cyboze
- kintoneとExcelとの連携まとめ
- excelからkintoneレコードを新規作成する方法について
- Kintone Excel 連携 キントーン レコードの取得・登録・更新・削除 マクロ VBA
- Excelとkintoneを連携 試しました！
- kintone REST APIで400/520エラーが出た時に確認すべき3つのこと！
- レコードの一括取得 - kintone
- OAuth 2.0を使ってcybozu.comのREST APIをPostmanで叩く方法
- OAuthクライアントの使用（スコープ）
