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でアンロックになるとのこと。
ファイルIDからBox Drive上のフルパスを構築する
Box APIを使って対象のファイルのIDから、Box Drive上のフルパスを構築する事が可能です。Box Driveはその場所が「C:¥Users¥ユーザ名¥Box」となっており、この下からがBox上のディレクトリ構造になっているので、APIでpath_collectionの部分を取得して構築すれば、IDのみで対象のファイルのドライブ上の在り処を突き止める事が可能です。ユーザ毎にフルパスが異なるので、少し工夫が必要です。
|
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 |
'ファイルIDからフルパスを構築する Public Function fileid2path(fileid) As String 'ログインユーザ名を取得する Dim username As String username = Environ("USERNAME") 'Box Driveのルートまでのパスを構築 Dim fullpath As String fullpath = "C:\Users\" & username & "\Box\" 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'JSON受信用 Dim Json As Variant Dim doc, jsn 'DB接続用 Dim SQL As String Dim db As DAO.Database Dim rs As DAO.Recordset Dim ret As Boolean 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" fileid2path = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" fileid2path = 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 'URLの組み立て Dim strUri As String Dim strMethod As String strUri = filepoint & fileid strMethod = "GET" 'リクエストの送信 Dim lockmode As Variant With CreateObject("WinHttp.WinHttpRequest.5.1") .Open strMethod, strUri, False .setProxy 2, proxyuri .setRequestHeader "Authorization", "Bearer " & access_token .send '返ってきた値をもとにデータを処理 Select Case .status Case 200 'JSONデータを取得する Json = .responseText 'HTMLDocumentを取得 Set doc = CreateObject("HtmlFile") 'scriptタグを追加 doc.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>" 'パース関数でJSONオブジェクトを取得 Set jsn = doc.JsonParse(Json) 'ファイル名を取得する Dim filename As String filename = CallByName(jsn, "name", VbGet) 'パスの深さを取得する Dim totalpath As Integer totalpath = CInt(jsn.path_collection.total_count) - 1 'パスを取得して結合する Dim i As Integer Dim tempjson Dim temprec As String '最初の「すべてのファイル」は不要なので1から開始する For i = 1 To totalpath 'パス階層を取得する Set tempjson = CallByName(jsn.path_collection.entries, i, VbGet) 'フォルダ名を取得 temprec = CallByName(tempjson, "name", VbGet) 'fullpathに結合する fullpath = fullpath & temprec & "\" Next 'ファイル名を結合する fullpath = fullpath & filename 'フルパスを返す fileid2path = fullpath Case Else MsgBox .status & "エラー" End Select End With '終了処理 Set rs = Nothing Set db = Nothing End Function |
- 普通にまず対象のファイルIDについての詳細な情報をリクエストする
- path_collectionのentriesには１個ずつパスが入ってる。このうち一番最初の「すべてのファイル」は不要なので、次の配列から処理をする
- また、同時にpath_collectionにはパスの個数が入ってるので（total_count）、これをループに利用する
- CallByName関数を使ってJSONを取り出していく
- ログインユーザ名はEnviron("USERNAME")で取得できるので、これを使い、Boxまでのフルパスを作成
- 上記のBoxまでのフルパスとpath_collectionのパスを連結、最後にファイル名をつなげて完全なfullpathを構築したら返す
path_collectionは上から順番にディレクトリのルートからとなっており、最後にファイル名を付けてあげれば完成です。レスポンス的には以下のような感じになっています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
"path_collection": { "entries": [ { "id": 12345, "etag": 1, "type": "folder", "sequence_id": 3, "name": "俺様フォルダ" }, { "id": 678910, "etag": 0, "type": "folder", "sequence_id": 4, "name": "VBA関係" }, ], "total_count": 2 }, |
Box DriveのパスからファイルID逆引き
Box Drive上のExcelやAccessのファイルを開いた時に、そのファイルに割り当てられてるファイルのIDを調べたいことがあります（このファイルIDに基づいてロックされてるかどうかの自動チェックを続けて行う等の需要があります）。しかし、Box Drive上のファイルそのものにファイルIDの情報があるわけではないので、Box APIの「コンテンツ検索API」を用いて、逆引きしてあげる必要があります。
この時必要になる情報は
- ファイル名および拡張子
- そのファイルが存在するBox上でのフルパス
これら二つを持ってリクエストや判定を行って絞り込み、対象のファイルのIDを逆引きすることが可能です。
|
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 |
'Box上からキーワードに基づいてファイルを検索する Public Function searchFileman() As String 'このファイルのパスを取得する Dim dirpath As String dirpath = CurrentProject.Path 'ユーザのBox Driveのパスを取得 Dim username As String Dim userbox As String username = Environ("USERNAME") userbox = "C:\Users\" & username & "\Box" 'Boxフォルダ上のファイルかどうかを判定 If dirpath Like userbox & "*" Then 'Box上にあるので処理をする Debug.Print "OK" Else 'Box上に無いので処理をしない searchFileman = "NG" Debug.Print "NG" Exit Function End If 'Access Tokenの取得と失効チェック Dim tokenstatus As Integer tokenstatus = checkExpireToken() 'JSON受信用 Dim Json As Variant Dim doc, jsn 'DB接続用 Dim SQL As String Dim db As DAO.Database Dim rs As DAO.Recordset Dim ret As Boolean 'Tokenの状況に応じて処理を分岐 Select Case tokenstatus Case 0 '無事にTokenは生きてるので何もしない Case 1 'refresh token使って新しいTokenを取得 ret = getNewToken() '取得結果を判定 If ret = True Then '無事に取得できているのでスルーする Else '取得失敗 MsgBox "Access Tokenの取得に失敗しました。" searchFileman = False Exit Function End If Case 2 '60日オーバーなので再認証をする Call boxAuthorization '終了処理 MsgBox "認証が期限切れです。再認証を実行してください。" searchFileman = 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 'ファイル名を指定 Dim fileName As String Dim extensionname As String Dim fso As New Scripting.FileSystemObject fileName = CurrentProject.Name extensionname = fso.GetExtensionName(fileName) fileName = fso.GetBaseName(fileName) 'Box以下のディレクトリ名を結合した値を生成 Dim pathsplit As Variant Dim boxpath As String Dim j As Integer pathsplit = Split(dirpath, "\") 'Boxディレクトリ以下を連結する For j = 4 To UBound(pathsplit) boxpath = boxpath & pathsplit(j) Next 'URLの組み立て（拡張子指定、ファイル名指定） Dim strUri As String Dim strMethod As String strUri = searchPoint & "?query=" & fileName & "&type=file&file_extensions=" & extensionname & "&content_types=name" strMethod = "GET" 'レスポンス用変数 Dim filecnt As Integer Dim dircnt As Integer Dim tempjson, pathcollection, dircollection, tempdir, temprec Dim i As Integer Dim k As Integer Dim res_fileid As String Dim res_folder As String Dim res_filename As String Dim temrec As String 'リクエストの送信 Dim lockmode As Variant 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 'JSONデータを取得する Json = .responseText 'HTMLDocumentを取得 Set doc = CreateObject("HtmlFile") 'scriptタグを追加 doc.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>" 'パース関数でJSONオブジェクトを取得 Set jsn = doc.JsonParse(Json) 'レスポンスの個数を取得 filecnt = jsn.total_count 'ファイルのIDと親ディレクトリ名を取得する For i = 0 To filecnt - 1 'folderidを初期化する res_folder = "" 'レコードを取得 Set tempjson = CallByName(jsn.entries, i, VbGet) 'ファイルIDを取得 res_fileid = CallByName(tempjson, "id", VbGet) 'ファイル名を取得 res_filename = CallByName(tempjson, "name", VbGet) 'ディレクトリの個数をpath_collectionから取得 Set pathcollection = CallByName(tempjson, "path_collection", VbGet) dircnt = CallByName(pathcollection, "total_count", VbGet) 'pathcollectionの名前を連結して格納(1個目はスルーする） Set dircollection = CallByName(pathcollection, "entries", VbGet) For k = 1 To dircnt - 1 'path階層を取得する Set tempdir = CallByName(dircollection, k, VbGet) 'フォルダ名を取得 temprec = CallByName(tempdir, "name", VbGet) '連結する res_folder = res_folder & temprec Next 'boxpathと一致するかどうかを判定 If res_folder = boxpath Then 'ループを終了する Exit For End If Next Case Else MsgBox .status & "エラー" searchFileman = "Error" Exit Function End Select End With Debug.Print res_fileid 'ファイルIDを返す searchFileman = res_fileid '終了処理 Set rs = Nothing Set db = Nothing End Function |
- Box上にあるファイルじゃない場合には処理をしないように冒頭で判定させています
- 現在開いてるファイル名およびその拡張子を取得し、リクエストを投げる為に利用しています。
- リクエストエンドポイントは「https://api.box.com/2.0/search」になります。GETなので、パラメータをつなげてstrUriを生成します
- 検索を絞り込む為に、queryはファイル名、content_typesをname、file_extensionに拡張子を、typeをfileを指定しています。
- 複数の結果が返ってくると思われるので、ここで各ファイルのIDとBox上のフルパスを構築
- 各ファイルのBox上のフルパスを連結させた値と、冒頭の自身のファイルのBox上のフルパスとを比較して同一のものであれば、それが逆引きされたファイルIDとなる（Boxは同じディレクトリ上に同一ファイル名のファイルが存在出来ない為）
- 最後に取得したファイルIDを返して終了
ただし注意点が１つ。アップロードしたてのファイルがBoxのインデックスに追加されるまで、企業で契約してる有償のBox Enterpriseであれば割と早く登録されますが（最大で10分くらい）、無償で利用できる個人のBoxの場合、相当長い間インデックスに登録されない為、実際にファイルを手動でアップロードして、検索してみるとなかなかヒットしません。ヒットしないということは、この逆引きでも検索で出てこないということなので要注意です。
合わせて以下のエントリーも参考にしてみてください。
使い所を考える
実際にBox上では、Box editを使えばExcelファイルを開ける！また、保存した時に自動的に同期するといった謳い文句がありますが、まぁ、バグが酷いです。Box Toolが入ってるにも関わらず、Excelを開くアプリケーションが無い（実際には入ってる）と言われたり、同期ミスったり、PCを起動する度に勝手にファイルが増殖するなど、ちょっと使い物になりません。
また、Box DriveというGoogle Drive File Streamと同じような機能の仕組みもあるのですが、古い企業ではネットワークトラフィックが耐えられなかったり、プロキシーサーバ経由の場合不具合が出るなどの理由で、利用が制限されていることもあります。それ故ファイルサーバの代わりにはならず、そうなると「Excelのファイル間リンク」「Wordの差し込み印刷」などいった機能が使えなくなります。APIを利用することでこれらをカバーすることが可能です。
