GoogleDriveへのアップロードをExcelマクロ（VBA）で実行してみた

TAG
API Excel VBA 渡部直樹
UPDATE
2019/03/10

GoogleDriveにファイルアップロードしてみる
疲弊しない現場のために
関連記事

皆様お疲れ様です。渡部です。

RPAを長くやっていると、PoC⇒本格導入⇒安定化・大規模化とどんどん範囲が広まっていくことを感じます。「安定化・大規模化」のところで避けて通れないのが、API化です。

最近はクラウドサービスをRPAで利用することが多くなりました。GoogleDrive・DropBox・BOXなどクラウドストレージへのファイルアップロード・ダウンロードはまだメジャーなところだと思われます。

しかし、クラウドサービスをRPAで普通に使う場合避けて通れないのが「意図しないタイミングでの画面変更」です。商用で使っている各種B2Bサービスなどはまだ「〇月〇日システム更新します」などの案内がホームページに掲載されることがあり、準備することができるのですが、クラウドサービスの場合は急に変更されてしまうことが多いです。もちろん、BluePrismのSPYパラメーターや、UiPathのSelectorを柔軟に対応できるようにしておくことは基本ですが、それでも対応できない場合もあります。

このような場合に有効になってくるのがAPIの利用です。もはやシステム開発ですね。今回は「GoogleDriveへのアップロードをExcelマクロ（VBA）で行う」のプログラム部分を紹介したいとおもいます。

なぜExcelマクロ（VBA）かというと、実はPythonなど他の言語であればGoogleのライブラリを使ってもう少し簡単に作れるのですが、情報統制の厳しいクライアント様の場合はインストールさせて貰えないので、とりえあず今のRPA実行環境（普通の業務PC）でできる範囲内ということでExcelマクロ（VBA）です。

GoogleDriveにファイルアップロードしてみる

今回はGoogleDriveのSimpleUploadという１ファイルのみのアップロードを行います。使うAPIはこちら。

Google Developers

Performing a Simple Upload | Drive REST API | Go...

コードは以下のとおりですが、本格運用時には複数ファイルの対応・エラーハンドリングなどプログラムの品質として必要なものを追加して運用します。

Sub fileupload()

'-- 変数定義を定義する
CLIENT_ID = "**************************************.apps.googleusercontent.com"
CLIENT_SECRET = "******************"
REDIRECT_URI = "urn:ietf:wg:oauth:2.0:oob"
SCOPE = "https://www.googleapis.com/auth/drive"
UPLOAD_FILE = "C:\Users\naoki.watanabe\Desktop\test.csv"

'-- IE を起動する
Dim objBrowser As Object
Set objBrowser = CreateObject("InternetExplorer.Application")
objBrowser.Visible = True
 
'-- ログイン画面を表示する
objBrowser.Navigate "https://accounts.google.com/o/oauth2/v2/auth?response_type=code&client_id=" & CLIENT_ID & "&redirect_uri=" & REDIRECT_URI & "&scope=" & SCOPE & "&access_type=offline"
 
'-- リダイレクトページに戻ってくるまで待つ（ブラウザの操作はRPAにて実施）
While objBrowser.ReadyState <> 4 Or objBrowser.Busy = True Or (StrComp(Left(objBrowser.LocationURL, Len("https://accounts.google.com/o/oauth2/approval/v2/approvalnativeapp")), "https://accounts.google.com/o/oauth2/approval/v2/approvalnativeapp") <> 0)
    DoEvents
Wend
Debug.Print objBrowser.LocationURL

'-- URL から response を取り出す
strQuery = Split(objBrowser.LocationURL, "?")(1)
arrQuery = Split(strQuery, "&")
strResponse = ""
For I = LBound(arrQuery) To UBound(arrQuery)
    arrElem = Split(arrQuery(I), "=")
    If StrComp(arrElem(0), "response") = 0 Then
        strResponse = arrElem(1)
        Debug.Print strResponse
    End If
Next

'-- responseをURLデコードする
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Set js = sc.CodeObject
strResponse = js.decodeURIComponent(strResponse)
Debug.Print strResponse

'-- response から code を取り出す
arrResponse = Split(strResponse, "&")
strCode = ""
For I = LBound(arrResponse) To UBound(arrResponse)
    arrElem = Split(arrResponse(I), "=")
    If StrComp(arrElem(0), "code") = 0 Then
        strCode = arrElem(1)
        Debug.Print strCode
    End If
Next
 
'-- ブラウザー終了
objBrowser.Quit
Set objBrowser = Nothing
 
'-- Access Token の取得 (HTTP POST 要求)
Dim objXHttp1 As Object
Set objXHttp1 = CreateObject("msxml2.xmlhttp")
objXHttp1.Open "POST", "https://www.googleapis.com/oauth2/v4/token", False
objXHttp1.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objXHttp1.send "code=" & strCode & "&client_id=" & CLIENT_ID & "&client_secret=" & CLIENT_SECRET & "&redirect_uri=" & REDIRECT_URI & "&grant_type=authorization_code&access_type=offline"
strToken1 = StrConv(objXHttp1.responsebody, vbUnicode)
Debug.Print objXHttp1.Status & vbNewLine & strToken1
Set objXHttp1 = Nothing
 
'-- Access Token のパース（とりあえずこれで）
strToken1 = Replace(strToken1, vbCr, "")
strToken1 = Replace(strToken1, vbLf, "")
strToken1 = Replace(strToken1, " ", "")
strToken1 = Replace(strToken1, """", "")
strToken2 = Mid(strToken1, InStr(strToken1, "{") + 1, Len(strToken1) - InStr(strToken1, "{") - (Len(strToken1) - InStrRev(strToken1, "}") + 1))
arrToken1 = Split(strToken2, ",")
strAccessToken = ""
For I = LBound(arrToken1) To UBound(arrToken1)
    strElem = arrToken1(I)
    arrToken2 = Split(strElem, ":")
    Debug.Print arrToken2(0) & ":" & arrToken2(1)
    If StrComp(arrToken2(0), "access_token") = 0 Then
        strAccessToken = arrToken2(1)
    End If
Next
Debug.Print strAccessToken
 
' Stream オブジェクトの作成と読み込み
Set Stream = CreateObject("ADODB.Stream")
Stream.Open
Stream.Type = 1 ' adTypeBinary
Stream.LoadFromFile = UPLOAD_FILE
 
'-- Google Drive SimpleUpload サービスの呼び出し
Dim objXHttp2 As Object
Set objXHttp2 = CreateObject("msxml2.xmlhttp")
objXHttp2.Open "POST", "https://www.googleapis.com/upload/drive/v3/files?uploadType=media", False
objXHttp2.setRequestHeader "Authorization", "Bearer " & strAccessToken
objXHttp2.setRequestHeader "Content-Type", "Text/Plain"
objXHttp2.setRequestHeader "Content-Length", Stream.Size
objXHttp2.send (Stream.read(Stream.Size))
Debug.Print objXHttp2.Status & vbNewLine & objXHttp2.responsetext
strResult = StrConv(objXHttp2.responsebody, vbUnicode)
Set objXHttp2 = Nothing

' Streamを閉じる
Stream.Close
Set Stream = Nothing

End Sub

疲弊しない現場のために

正直、安定化のためにこういう手段を取ることはプログラムの開発スキルを求められ、どの現場でもできる話ではありません。クラウドサービスに変更があった場合にすぐに変更対応できるような運用体制を作っておくことでもいいです。ただ、即時対応は実際は難しく、APIの利用を勧めている場合もあります。VBAからのAPI参照のための参考コードを記載させていただきましたが、他の現場の参考になれば幸いです。RPA開発におけるAPI利用についてのご相談はこちらからお問い合わせ下さい。