Excel VBA と Kintone を連携するマクロ

ここではKintoneをSQLのようなデータベース機能として使って、データの入出力はExcel上で行うことを前提で作成しています。

「そもそもKintoneで入出力したらいいじゃん」と思う方もいらっしゃると思いますが、

　・もともとグループウェアとしてGaroonを使っているので、既存ユーザーにKintone権限を付与するとその分ランニングコストが増えるので避けたい。

　・1つのアカウントを使いまわすにしてもわざわざ入力用でKintoneのアカウントにログインし直すのも面倒。

　・現場の人間がExcelでの日報入力に慣れているので、そのフォーマット（環境）を変えずにいきたい。
　　~~（本音は新しいソフトの使い方をレクチャするのが面倒だったり……）~~

つまり、1つのkintoneアカウントで色んな業種の日報を管理したいからという事情でマクロを組みました。

前置きが長くなりました。。。
早速、いってみましょう！

今回は、ExcelでKintoneに接続して、データを呼び出すところまでを紹介します。
最後にサンプルのExcelファイルをダウンロードできるリンクを貼っておきますので、面倒な方はそちらダウンロードしてお使い下さい。

Kintone側で操作したいアプリの設定を行う
Excel上でJsonを使えるようにする。
VBAで連携するマクロを組む
まとめ

Kintone側で操作したいアプリの設定を行う

操作したいアプリのアプリ番号をメモ

操作したいアプリを開き、APIトークンの作成を行う。
作成後、レコードの閲覧・追加・編集・削除にチェックを入れて保存します。

Excel上でJsonを使えるようにする。

下記からJsonをパースするクラスモジュールをダウンロードします。

こちらからダウンロード

Excelに先ほどダウンロードした「Jsonlib.cls」のクラスモジュールをインポートします。

参照設定で以下をライブラリを組み込みます。

Microsoft XML, V6.0
Microsoft Scripting Runtime

これで下準備はOK。

VBAで連携するマクロを組む

まずは、Kintoneと接続するための基本情報を取得するためのマクロを組みます。

Option Explicit

Public AppID As Integer
Public APItoken As String
Public Domain As String
Public kintoneURL(1) As String


'-----------------------------------
'Kintoneに接続するための基本情報格納
'-----------------------------------

Sub connect_kintone()

AppID = 1 '接続したいアプリ番号
APItoken = "****************************************" '接続したいアプリのAPIトークン
Domain = "*****.cybozu.com" 'Kintone独自ドメイン

kintoneURL(0) = "https://" & Domain & "/k/v1/records.json?app=" & AppID '複数レコード用
kintoneURL(1) = "https://" & Domain & "/k/v1/record.json?app=" & AppID '単一レコード用


End Sub

次にキントンからデータを呼び出すマクロを組みます。
今回は、レコード番号（record_no）、日付（date）、数値（point）からC3セルに入力された対象の日付と一致するデータを呼び出すものを作成してみました。

※()内はフィールドコードです。Kintone側で設定してください。私の知識がないせいかフィールドコードが日本語だとエンコードがうまくいかないのかクエリを書いた時にエラーで弾かれますのでご注意。

'-----------------------------------
'Kintoneからレコードを呼び出す
'-----------------------------------

Sub get_kintone()


Call connect_kintone   'キントンの接続情報を呼び出す


'▼クエリで絞り込みする時
Dim KintoneQuery As String


KintoneQuery = "date=""" & Format(Cells(3, 3), "yyyy-mm-dd") & """"  '例①：日付で絞り込み
KintoneQuery = KintoneQuery & "order by record_no asc limit 500" 'レコード番号順で上位500件までを取得

If Len(KintoneQuery) > 0 Then  'クエリを指定した場合はURLを編集

    Debug.Print (KintoneQuery)

    KintoneQuery = URL_Encode(KintoneQuery)
    kintoneURL(0) = kintoneURL(0) & "&query=" & KintoneQuery

    Debug.Print (kintoneURL(0)) 'URL確認用

End If


'▼Kintoneに接続する
Dim objHttpReq As Object
Dim strJSON As String
    
Set objHttpReq = CreateObject("MSXML2.XMLHTTP")
objHttpReq.Open "GET", kintoneURL(0), False　’今回はデータの取得なのでGET
'"GET"で取得／"POST"で登録／"POST"で更新／"DEL"で削除"

objHttpReq.setRequestHeader "X-Cybozu-Api-Token", APItoken 'APIトークンで認証
objHttpReq.setRequestHeader "Host", Domain + ":443" 'ドメイン：ポート番号
objHttpReq.setRequestHeader "If-Modified-Since", "Thu,01 Jun 1970 00:00:00 GMT" 'キャッシュ対策

objHttpReq.send (Null)

strJSON = objHttpReq.responseText
Debug.Print (strJSON)


'▼取得したレコードをセルに転記
Dim record As Variant
Dim insertRow As Long

Dim objJSON As Object
Set objJSON = parseJSON(strJSON)

Range("B7:D516").ClearContents

If objJSON("records").Count = 0 Then

    MsgBox "対象のデータはありませんでした。"
    End
    
Else

    insertRow = 7 'レコードの転記開始行
    
    For Each record In objJSON("records")
    
        Cells(insertRow, 2) = record.Item("record_no").Item("value")
        Cells(insertRow, 3) = record.Item("date").Item("value")
        Cells(insertRow, 4) = record.Item("point").Item("value")
                
        insertRow = insertRow + 1

    Next
    
    MsgBox insertRow - 6 & "件のレコードを取得しました。"

End If


End Sub

Option Explicit

'----------------------------------------------
'JSONをパース
'----------------------------------------------
Function parseJSON(strJSON As String)
    Dim lib As New JSONLib
    
    Set parseJSON = lib.parse(CStr(strJSON))
End Function


'----------------------------------------------
'URLをエンコード
'Usage: URL_Encode("文字列")
'----------------------------------------------

Function URL_Encode(ByVal strOrg As String)
    Dim d As Object
    Dim elm As Object
    
    strOrg = Replace(strOrg, "\", "\\")
    strOrg = Replace(strOrg, "'", "\'")
    Set d = CreateObject("htmlfile")
    Set elm = d.createElement("span")
    elm.setAttribute "id", "result"
    d.body.appendChild elm
    d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & strOrg & "');", "JScript"
    URL_Encode = elm.innertext
End Function

上記のマクロを実装したExcelデータはこちらからダウンロードできます！
（使用については自己責任でお願いします）

まとめ

今回は、第１回目でしたので、APIトークンを使ったKintoneとの接続および簡単なデータの呼び出しをご紹介しました！

次回以降でレコードの登録や更新、削除、各フィールドの呼び出しについてはご紹介したいと思います♪