VBAからBox APIを叩いてみる – 実践編
前回、Box APIを叩くための準備を行いました。社内で使う事を想定しWinHTTPRequestでプロキシーを超える為の設定も含めて、準備の紹介を行いました。すでにAccess Tokenは取得ができているのと、リフレッシュトークンを使った再取得の方法も紹介しています。
今回は、このAccess Tokenを使って、Box APIの中でもよく使うであろう、アップロード・ダウンロード・名前の変更・ファイルの削除・ファイルのロックをしてみたいと思います。また、加えてこのAPIを利用したアプリの使い所を研究してみたいと思います。
難易度：
リンク
今回使用するファイルとライブラリ
ソースコード
ファイルのダウンロード
ファイルのダウンロードでは、ファイルのIDが必要です。ファイルのIDとは、「https://app.box.com/file/306826865097」とあった場合の「306826865097」の部分。これを指定します。BoxではContent PickerというGoogle Picker APIのようなものも用意されていますが、VBAから使うには厳しいので、直で指定しておく必要があります。
|
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 |
'APIアクセス用エンドポイントURL Private Const filepoint As String = "https://api.box.com/2.0/files/" 'ファイルダウンロード関数（CurrentProject.pathにダウンロード） Public Function getFileDownload() As Boolean 'DB接続用 Dim SQL As String Dim db As DAO.Database Dim rs As DAO.Recordset Dim ret As Variant 'バイナリファイル生成用 Dim FileData() As Byte Dim FileNum As Long 'ファイルのIDを指定 Dim fileid As Variant fileid = "306826865097" 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'JSON受信用 Dim Json As Variant Dim doc, jsn 'HTMLDocumentを取得 Set doc = CreateObject("HtmlFile") 'scriptタグを追加 doc.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>" 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" getFileDownload = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" getFileDownload = False Exit Function End Select 'Access Tokenを取得する Set db = CurrentDb() Set rs = db.OpenRecordset("tokeninfo", dbOpenDynaset) Dim access_token As String access_token = rs!access_token 'フォルダ情報を取得する 'POST通信でAPIを叩いてデータを取得 Dim getinfourl As String Dim disposition As String Dim tempheader As Variant getinfourl = filepoint & fileid & "/content" With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "GET", getinfourl, False '.setProxy 2, proxyuri 'プロキシサーバのURLとポート番号 .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Authorization", "Bearer " & access_token .send '返ってきた値をもとにデータを処理 Select Case .status Case 200 'レスポンスヘッダを取得 Debug.Print .GetAllResponseHeaders() 'バイナリデータを取得 FileData = .responseBody 'ファイル名を取得する tempheader = .GetResponseHeader("Content-Disposition") disposition = DEcodeURLMSHTML(Mid(tempheader, InStr(tempheader, "filename*=UTF-8''") + 17)) 'ファイルパス組み立て FilePath = CurrentProject.Path & "\" & disposition 'バイナリデータを生成する FileNum = FreeFile() Open FilePath For Binary Access Write As #FileNum Put #FileNum, 1, FileData Close #FileNum Case Else getFileDownload = False End Select End With '終了処理 Set db = Nothing Set rs = Nothing getFileDownload = True End Function |
- ファイル名の取得の行にて、帰ってくるファイル名（UTF8）をデコードする為に、DecodeURLMSHTMLという関数を利用しています。利用する為には、参照設定にて「Microsoft HTML Object Library」が必要です。
- この項目の基本ですが、Tokenが生存してるかどうかの判定ルーチンにて、期限切れの場合リフレッシュトークンで取得し直し、ルーチンを続行させています。
- ファイルはとりあえず、プログラムのある同じフォルダ内に生成されます。
- ファイル名などの情報は、Content-Dispositionヘッダー内に含まれていて、ここから取り出します。ヘッダの内容は以下のような感じ
- 使用するエンドポイントURLは、https://api.box.com/2.0/files/となります。
|
1 2 3 4 5 6 7 8 9 10 11 |
Cache-Control: private Connection: keep-alive Date: Sun, 21 Oct 2018 01:21:27 GMT Content-Length: 4283254 Content-Type: image/jpeg Accept-Ranges: bytes Age: 0 Content-Disposition: attachment;filename="P_20180722_165428.jpg";filename*=UTF-8''P_20180722_165428.jpg X-Robots-Tag: noindex, nofollow X-Content-Type-Options: nosniff Strict-Transport-Security: max-age=31536000 |
ファイルのアップロード
Box APIで最も面倒なルーチンは、ファイルのアップロードです。バイナリデータを送らなければならないため、様々な処理を追加しなければなりません。そのため、送信パラメータが複雑です。フォルダのIDおよびファイルのID、ファイル名、MIMETYPEが必要となります。今回はjpgファイルを送り込むので、ファイルのMIMETYPEは「image/jpeg」となります。ZIPならば「application/x-compress」ですね。
今回この部分については、大変よくできたルーチンがありますので、こちらを利用しました。
|
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 |
Const adTypeBinary = 1 Const adTypeText = 2 Const adBTypeContent = 1 Const adBTypeBody = 2 Const adBTypeFooter = 3 Private Const uploadpoint As String = "https://upload.box.com/api/2.0/files/" Public Function BoxUploadFile() '変数の宣言 Dim ret As Variant 'DB接続用 Dim db As DAO.Database Dim rs As DAO.Recordset 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" Exit Function End Select 'Boxへ送信するファイルとその情報 Dim FilePath As String: FilePath = CurrentProject.Path & "\" & "P_20180722_165428.jpg" Dim strMethod As String: strMethod = "POST" Dim strUri As String Dim strResult As String Dim folderid As Variant Dim fileid As Variant folderid = "51765426966" fileid = "306826865097" 'URLの組み立て strUri = uploadpoint & fileid & "/content" 'ファイルのMIME TYPE Dim contentType As String contentType = "image/jpeg" 'Access Tokenを取得する Set db = CurrentDb() Set rs = db.OpenRecordset("tokeninfo", dbOpenDynaset) Dim access_token As String access_token = rs!access_token 'ADODBで領域確保 Dim tempParamStream As Object Set tempParamStream = CreateObject("ADODB.Stream") tempParamStream.Open 'リクエストパラメータを構築 Dim FileName As String FileName = Dir(FilePath) Dim JsonObject As Object Set JsonObject = New Dictionary JsonObject.Add "name", FileName JsonObject.Add "parent", New Dictionary JsonObject("parent").Add "id", folderid If SetNomarlParameter(tempParamStream, "attributes", JsonConverter.ConvertToJson(JsonObject)) Then End If If SetFileParmater(tempParamStream, "file", FilePath, contentType) Then End If If SetEndParameter(tempParamStream) Then End If 'リクエストパラメータを取得 Dim snedParameter As Variant GetSendParameter snedParameter, tempParamStream 'リクエストの送信 With CreateObject("WinHttp.WinHttpRequest.5.1") .Open strMethod, strUri, False '.setProxy 2, proxyuri .setRequestHeader "Content-Type", "multipart/form-data; boundary=" + getBoundy(adBTypeContent) .setRequestHeader "Authorization", "Bearer " & access_token .send snedParameter '返ってきた値をもとにデータを処理 Select Case .status Case 200, 201 'レスポンスヘッダを取得 Debug.Print .GetAllResponseHeaders() '投稿結果 strResult = .responseText Debug.Print strResult Case Else MsgBox .status & "エラー。アップロードは失敗しました。" End Select End With '終了処理 Set rs = Nothing Set db = Nothing End Function |
- パラメータの構築では、SetNomarlParameter、SetFileParmater、SetEndParameter、GetSendParameter、ChangeStreamType、getBoundyをこちらのサイトのコードを利用させていただきました。
- アップロードは上書きアップロードされます。バージョンが重なってる点で判別が可能です。
- フォルダIDおよびファイルID、ファイルのパスは固定にしてしまってるので、ここを手直しする必要があります。
- リクエストパラメータの設定に失敗すると文字化けしてアップロードされてしまいます。
- HeaderリクエストにあるBoundaryとは、バウンダリ文字列と呼ばれるもので、適当な文字列なのですが、リクエスト文の境界線で用いられる文字列で必須です（文字種と文字数が一致していればUUIDのように生成して使って問題ない）。
- ファイルの種類ごとにMIMETYPEは異なるので、より汎用的な関数にするには、拡張子などからMIMEを設定するルーチンが必要です。
図：ファイルの版がアップデートされてることを確認
名前の変更
ファイル・フォルダの名前の変更には、新しいファイル名、ファイル・フォルダのIDが必要になります。また、今回は一つの関数でファイルとフォルダのリネームに対応させているので、フラグも必要（0ならばファイルのリネーム、1ならばフォルダのリネーム）。
|
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 |
'エンドポイントURL Private Const renamepoint As String = "https://api.box.com/2.0/files/" Private Const renfolpoint As String = "https://api.box.com/2.0/folders/" 'BOX ファイル名変更ルーチン Public Function BoxRename(flg As Integer, newname As String, fid As Variant) As Boolean '変数の宣言 Dim ret As Variant 'DB接続用 Dim db As DAO.Database Dim rs As DAO.Recordset 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" BoxRename = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" BoxRename = False Exit Function End Select 'Boxへ送信するファイルとその情報 Dim strMethod As String: strMethod = "PUT" Dim strUri As String Dim strResult As String 'URLの組み立て If flg = 0 Then 'ファイルのリネーム strUri = renamepoint & fid Else 'フォルダのリネーム strUri = renfolpoint & fid End If 'Access Tokenを取得する] Set db = CurrentDb() Set rs = db.OpenRecordset("tokeninfo", dbOpenDynaset) Dim access_token As String access_token = rs!access_token 'リクエスト用のパラメータを構築 Dim JsonObject As Object Set JsonObject = New Dictionary JsonObject.Add "name", newname '送信リクエスト With CreateObject("WinHttp.WinHttpRequest.5.1") .Open strMethod, strUri, False '.setProxy 2, proxyuri .setRequestHeader "Authorization", "Bearer " & access_token .send JsonConverter.ConvertToJson(JsonObject) '返ってきた値をもとにデータを処理 Select Case .status Case 200, 201 'レスポンスヘッダを取得 Debug.Print .GetAllResponseHeaders() '投稿結果 strResult = .responseText Debug.Print strResult Case Else MsgBox .status & "エラー。リネームは失敗しました。" BoxRename = False '終了処理 Set rs = Nothing Set db = Nothing Exit Function End Select End With '終了処理 Set rs = Nothing Set db = Nothing '値を返す BoxRename = True End Function |
- 引数のflgでファイルのリネームか？フォルダのリネームかを判定しています。
- ファイルとフォルダとで、それぞれ利用するエンドポイントURLが異なります。
- ファイルの場合のエンドポイントURLは、https://api.box.com/2.0/files/となります。フォルダの場合のエンドポイントURLは、https://api.box.com/2.0/folders/となります。
- パラメータの構築はJSON形式で作って送ってあげる必要があるため、VBA-JSONのJsonConverterを利用しています。
- WinHTTPRequestでの送信メソッドは「PUT」ですので注意が必要です。
ファイルの削除
ファイルの削除はファイルのIDがあれば問題ありません。こちらも１つの関数でファイルとフォルダの削除に対応させているので、flgを引数に与えています。
|
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 |
'エンドポイントURL Private Const renamepoint As String = "https://api.box.com/2.0/files/" Private Const renfolpoint As String = "https://api.box.com/2.0/folders/" 'BOX ファイル削除ルーチン Public Function BoxDelete(flg As Integer, fid As Variant) As Boolean '変数の宣言 Dim ret As Variant 'DB接続用 Dim db As DAO.Database Dim rs As DAO.Recordset 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" BoxDelete = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" BoxDeleteFile = False Exit Function End Select 'Boxへ送信するファイルとその情報 Dim strMethod As String: strMethod = "DELETE" Dim strUri As String Dim strResult As String 'URLの組み立て If flg = 0 Then strUri = renamepoint & fid Else strUri = renfolpoint & fid & "?recursive=true" End If 'Access Tokenを取得する Set db = CurrentDb() Set rs = db.OpenRecordset("tokeninfo", dbOpenDynaset) Dim access_token As String access_token = rs!access_token '送信リクエストを送る With CreateObject("WinHttp.WinHttpRequest.5.1") .Open strMethod, strUri, False '.setProxy 2, proxyuri .setRequestHeader "Authorization", "Bearer " & access_token .send '返ってきた値をもとにデータを処理 Select Case .status Case 200, 201, 204 'レスポンスヘッダを取得 Debug.Print .GetAllResponseHeaders() '投稿結果 strResult = .responseText Debug.Print strResult Case Else MsgBox .status & "エラー。削除は失敗しました。" BoxDelete = False '終了処理 Set rs = Nothing Set db = Nothing Exit Function End Select End With '終了処理 Set rs = Nothing Set db = Nothing '値を返す BoxDelete = True End Function |
- ほぼファイルのリネームと同じルーチンですが、エンドポイントURLにつなげる項目がフォルダの場合の削除は少々異なります。
- WinHTTPRequestでの送信メソッドは「DELETE」ですので注意が必要です。
- 特に送信にあたってリクエスト文を組み立てる必要がないのでシンプルですね。
ファイルのロック
ファイルのロックはロックしている最中はファイルのダウンロードを阻止したり、編集の禁止をさせる為のものです。GUI上では誰でも簡単にロックは外せてしまうので、強力なものではないのですが、社内で使う上では必須です。ロックを掛けずにファイルの上書きがバッティングすると、あとから上書きしたファイルはファイルの整合性がズレ、別ファイルとして分離されてしまう仕組みなので、このロックは有効活用すべきですね。
|
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 |
'エンドポイントURL Private Const renamepoint As String = "https://api.box.com/2.0/files/" 'Boxのファイルをロックもしくは解除するルーチン Public Function BoxFileLock(fid As Variant) As Boolean '変数の宣言 Dim ret As Variant 'DB接続用 Dim db As DAO.Database Dim rs As DAO.Recordset 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" BoxFileLock = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" BoxFileLock = False Exit Function End Select 'Boxへ送信するファイルとその情報 Dim strMethod As String: strMethod = "PUT" Dim strUri As String Dim strResult As String 'URLの組み立て strUri = renamepoint & fid 'Access Tokenを取得する] Set db = CurrentDb() Set rs = db.OpenRecordset("tokeninfo", dbOpenDynaset) Dim access_token As String access_token = rs!access_token 'リクエストパラメータの構築 Dim JsonObject As Object Set JsonObject = New Dictionary JsonObject.Add "lock", New Dictionary JsonObject("lock").Add "type", "lock" JsonObject("lock").Add "expires_at", "2018-10-05T0:00:00+09:00" 'グリニッジ標準時に9時間加算させてある JsonObject("lock").Add "is_download_prevented", False 'リクエストの送信 With CreateObject("WinHttp.WinHttpRequest.5.1") .Open strMethod, strUri, False '.setProxy 2, proxyuri .setRequestHeader "Authorization", "Bearer " & access_token .send JsonConverter.ConvertToJson(JsonObject) '返ってきた値をもとにデータを処理 Select Case .status Case 200, 201 'レスポンスヘッダを取得 Debug.Print .GetAllResponseHeaders() '投稿結果 strResult = .responseText Debug.Print strResult Case Else MsgBox .status & "エラー。ファイルのロックは失敗しました。" BoxFileLock = False '終了処理 Set rs = Nothing Set db = Nothing Exit Function End Select End With '終了処理 Set rs = Nothing Set db = Nothing '値を返す BoxFileLock = True End Function |
- パラメータの構築はJSON形式で作って送ってあげる必要があるため、VBA-JSONのJsonConverterを利用しています。
- パラメータ上、いつまでロックするか？の時間は、そのままではexpire_atの時刻はGMTなのでここに常に9時間を足した時間で指定しないと、日本ではおかしなロックになってしまいます。
- 今回のルーチンでは、expire_atの時刻指定（何時間後まで）の部分はしっかり作っていないので、実用する場合は、少し手直しが必要です。
- WinHTTPRequestでの送信メソッドは「PUT」ですので注意が必要です。
- ファイルに対してしかロックはできません。
- is_download_preventedはFalseですとファイルのダウンロードもロックします。
- 今回のメソッドはDictionaryオブジェクトを利用しているので、参照設定として「Microsoft Scripting Runtime」が必要です。
- アンロックする場合は、JsonObjectにAddする部分で、JsonObject(“lock”).Add nullでアンロックになるとのこと。
使い所を考える
実際にBox上では、Box editを使えばExcelファイルを開ける！また、保存した時に自動的に同期するといった謳い文句がありますが、まぁ、バグが酷いです。Box Toolが入ってるにも関わらず、Excelを開くアプリケーションが無い（実際には入ってる）と言われたり、同期ミスったり、PCを起動する度に勝手にファイルが増殖するなど、ちょっと使い物になりません。
また、Box DriveというGoogle Drive File Streamと同じような機能の仕組みもあるのですが、古い企業ではネットワークトラフィックが耐えられなかったり、プロキシーサーバ経由の場合不具合が出るなどの理由で、利用が制限されていることもあります。それ故ファイルサーバの代わりにはならず、そうなると「Excelのファイル間リンク」「Wordの差し込み印刷」などいった機能が使えなくなります。APIを利用することでこれらをカバーすることが可能です。
