VBAからBox APIを叩いてみる - 実践編

前回、Box APIを叩くための準備を行いました。社内で使う事を想定しWinHTTPRequestでプロキシーを超える為の設定も含めて、準備の紹介を行いました。すでにAccess Tokenは取得ができているのと、リフレッシュトークンを使った再取得の方法も紹介しています。

今回は、このAccess Tokenを使って、Box APIの中でもよく使うであろう、アップロード・ダウンロード・名前の変更・ファイルの削除・ファイルのロックをしてみたいと思います。また、加えてこのAPIを利用したアプリの使い所を研究してみたいと思います。

今回使用するファイルとライブラリ

• Box APIを装備したAccessファイル
• VBA-JSON
• Box API Reference

ソースコード

ファイルのダウンロード

ファイルのダウンロードでは、ファイルのIDが必要です。ファイルのIDとは、「https://app.box.com/file/306826865097」とあった場合の「306826865097」の部分。これを指定します。BoxではContent PickerというGoogle Picker APIのようなものも用意されていますが、VBAから使うには厳しいので、直で指定しておく必要があります。

'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ヘッダー内に含まれていて、ここから取り出します。ヘッダの内容は以下のような感じ

  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

• 使用するエンドポイントURLは、https://api.box.com/2.0/files/となります。

ファイルのアップロード

Box APIで最も面倒なルーチンは、ファイルのアップロードです。バイナリデータを送らなければならないため、様々な処理を追加しなければなりません。そのため、送信パラメータが複雑です。フォルダのIDおよびファイルのID、ファイル名、MIMETYPEが必要となります。今回はjpgファイルを送り込むので、ファイルのMIMETYPEは「image/jpeg」となります。ZIPならば「application/x-compress」ですね。

今回この部分については、大変よくできたルーチンがありますので、こちらを利用しました。

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ならばフォルダのリネーム）。

'エンドポイント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を引数に与えています。

'エンドポイント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上では誰でも簡単にロックは外せてしまうので、強力なものではないのですが、社内で使う上では必須です。ロックを掛けずにファイルの上書きがバッティングすると、あとから上書きしたファイルはファイルの整合性がズレ、別ファイルとして分離されてしまう仕組みなので、このロックは有効活用すべきですね。

'エンドポイント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のみで対象のファイルのドライブ上の在り処を突き止める事が可能です。ユーザ毎にフルパスが異なるので、少し工夫が必要です。

'ファイル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は上から順番にディレクトリのルートからとなっており、最後にファイル名を付けてあげれば完成です。レスポンス的には以下のような感じになっています。

"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を逆引きすることが可能です。

'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上では、Box editを使えばExcelファイルを開ける！また、保存した時に自動的に同期するといった謳い文句がありますが、まぁ、バグが酷いです。Box Toolが入ってるにも関わらず、Excelを開くアプリケーションが無い（実際には入ってる）と言われたり、同期ミスったり、PCを起動する度に勝手にファイルが増殖するなど、ちょっと使い物になりません。

また、Box DriveというGoogle Drive File Streamと同じような機能の仕組みもあるのですが、古い企業ではネットワークトラフィックが耐えられなかったり、プロキシーサーバ経由の場合不具合が出るなどの理由で、利用が制限されていることもあります。それ故ファイルサーバの代わりにはならず、そうなると「Excelのファイル間リンク」「Wordの差し込み印刷」などいった機能が使えなくなります。APIを利用することでこれらをカバーすることが可能です。

関連リンク

• Request to Add Overwrite/Version Functionality to File Copy Operations via API
• Get file ID of a given path
• Finding a file by filename #344