Office関連

Instagram APIをVBAから呼び出してみる。

最近画像共有系のSNS、Instagram(インスタグラム)を使い始めました。

このサービスも他のSNSと同様にAPIが用意されているので、さっそくVBAから使ってみたいと思います。

Client ID他の取得

APIを利用するにはClient IDやClient Secretといった情報が必要になるので、まずは開発者向けサイトから必要な情報を取得します。

  1. Manage Clients」をクリックし、WebサイトのURLや電話番号と言った項目を入力し、「Sign up」ボタンをクリックします。
  2. InstagramAPI_01

  3. Manage Clients画面が表示されたら「Register a New Client」ボタンをクリックします。
  4. InstagramAPI_02

  5. アプリケーション名などの項目を入力し、「Register」ボタンをクリックします。
  6. InstagramAPI_03

  7. 登録が無事に終わると、Client IDやClient Secretが表示されるので、メモ帳にでも控えておきます。
  8. InstagramAPI_04

VBAからの呼び出し

準備ができたら、いよいよAPIの呼び出しです。
InstagramのAPIもMicrosoft GraphなどのAPIと同様、

code(authorization)取得

access token取得

エンドポイントにリクエストを投げて結果を取得

といった利用手順になっています。
下記コードでは「/users/self/media/recent」にリクエストを投げ、返ってきた結果から画像ファイルだけを指定フォルダーに保存する処理を行います。

Option Explicit

Public Sub SampleInstagramAPI()
'サンプル - Instagram API呼び出し
'※ ScriptControlを使っているため、32ビット環境のみ対応
'※ リダイレクト URIをlocalhostにしている場合は、ローカルサーバー(XAMPP他)の起動が必要な場合があります。
  Dim url_auth As String
  Dim url_token As String
  Dim url_api As String
  Dim url As String
  Dim q As String
  Dim code As String
  Dim js As String
  Dim access_token As String
  Dim dat As Variant
  Dim ary As Variant, ary2 As Variant
  Dim item As Object, items As Object
  Dim images As Object
  Dim fol As String
  Dim file As String
  Dim v As Variant
  Dim i As Long
  Dim data, [type], standard_resolution 'JSONパース用ダミー
  Const READYSTATE_COMPLETE = 4
  
  '**********************************************************************
  'クライアント ID, クライアント シークレット, リダイレクト URI
  Const client_id As String = "(クライアント ID)"
  Const client_secret As String = "(クライアント シークレット)"
  Const redirect_uri As String = "(リダイレクト URI)"
  '**********************************************************************
  
  '画像ファイルの保存先選択
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "画像ファイルの保存先フォルダーを選択してください。"
    .AllowMultiSelect = False
    .InitialFileName = CreateObject("Shell.Application") _
      .Namespace(0).Self.Path & Application.PathSeparator 'デスクトップ
    If .Show = True Then
      fol = .SelectedItems(1)
    Else
      Exit Sub
    End If
  End With
  fol = AddPathSeparator(fol)
  
  'authorization code取得
  code = "" '初期化
  url_auth = "https://api.instagram.com/oauth/authorize/?response_type=code" & _
             "&redirect_uri=" & EncodeURL(redirect_uri) & _
             "&client_id=" & client_id
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Width = 600
    .Height = 480
    .Navigate url_auth
    While .ReadyState <> READYSTATE_COMPLETE Or _
          .Busy = True Or _
          (StrComp(Left(.LocationURL, Len(redirect_uri)), redirect_uri) <> 0)
      DoEvents
    Wend
    q = .document.parentWindow.Location.Search
    q = Mid(q, 2) '"?"削除
    ary = Split(q, "&")
    For i = LBound(ary) To UBound(ary)
      ary2 = Split(ary(i), "=")
      If LCase(ary2(0)) = "code" Then
        code = ary2(1)
        Exit For
      End If
    Next
    .Quit
  End With
  If Len(Trim(code)) < 1 Then Exit Sub
  
  'access token取得
  js = "": access_token = "" '初期化
  url_token = "https://api.instagram.com/oauth/access_token"
  dat = "grant_type=authorization_code" & _
        "&code=" & code & _
        "&client_id=" & client_id & _
        "&client_secret=" & client_secret & _
        "&redirect_uri=" & EncodeURL(redirect_uri)
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", url_token, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send dat
    Select Case .Status
      Case 200: js = .responseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  js = "(" & js & ")"
  With CreateObject("ScriptControl")
    .Language = "JScript"
    access_token = .CodeObject.eval(js).access_token
  End With
  If Len(Trim(access_token)) < 1 Then Exit Sub

  'Instagram APIを呼び出して画像ファイル保存
  js = "" '初期化
  url_api = "https://api.instagram.com/v1/users/self/media/recent/?access_token=" & access_token
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url_api, False
    .send
    Select Case .Status
      Case 200: js = .responseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  js = "(" & js & ")"
  With CreateObject("ScriptControl")
    .Language = "JScript"
    Set items = .CodeObject.eval(js).data
    For Each item In items
      Select Case item.type
        Case "image" '画像のみ処理
          Set images = item.images
          url = images.standard_resolution.url
          v = Split(url, "/")
          file = LCase(v(UBound(v)))
          file = Left(file, InStr(file, ".jpg") + 3)
          DownloadFile url, fol & file
      End Select
    Next
  End With
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Sub DownloadFile(ByVal url As String, ByVal SaveFilePath As String)
  Dim req As Object
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
  
  Set req = Nothing '初期化
  Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
  If req Is Nothing Then Exit Sub
  req.Open "GET", url, False
  req.send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile SaveFilePath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      MsgBox "エラーが発生しました。" & vbCrLf & _
             "ステータスコード:" & req.Status, _
             vbCritical + vbSystemModal
      Exit Sub
  End Select
End Sub

Private Function EncodeURL(ByVal Target As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(Target)
  End With
End Function

Private Function AddPathSeparator(ByVal s As String) As String
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

コードの実行

上記コードを実行すると、下記の流れで処理が行われます。

  1. 画像ファイルを保存するフォルダーを選択します。
  2. InstagramAPI_05

  3. Instagramの認証画面が表示されるので、ユーザーネームとパスワードを入力し「ログイン」ボタンをクリックします。
  4. InstagramAPI_06

  5. 承認画面が表示されたら「Authorize」ボタンをクリックします。
  6. InstagramAPI_07

  7. API呼び出しが無事に行われると、画像ファイルが1.で指定したフォルダーにダウンロードされます。
  8. InstagramAPI_08

おわりに

以前は好きなスコープを設定できたらしいのですが、現在ではAPIの呼び出しはサンドボックスモードで行われ、一部制限が掛かっています。

・Sandbox Mode – Instagram Developer Documentation
https://www.instagram.com/developer/sandbox/

審査を通過すればライブモードに切り替えることができますが、なかなか厳しい審査のようですね。

・超厳しい 【Instagram API 】の審査基準 を翻訳してまとめてみた
http://www.ie-kau.net/entry/2016/01/26/%E8%B6%85%E5%8E%B3%E3%81%97%E3%81%84_%E3%80%90Instagram_API_%E3%80%91%E3%81%AE%E5%AF%A9%E6%9F%BB%E5%9F%BA%E6%BA%96_%E3%82%92%E7%BF%BB%E8%A8%B3%E3%81%97%E3%81%A6%E3%81%BE%E3%81%A8%E3%82%81%E3%81%A6%E3%81%BF

ただ、制限はあれどある程度の範囲であればAPIを自由に呼び出せるので、なかなか遊び甲斐があるだろうと思います。

東京でオトカドールのプレイが録画できるようになりました(2)前のページ

Google Sheets API v4が登場しました。次のページ

関連記事

  1. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  2. Office関連

    VBAでインターネット上のファイルをダウンロードする方法をまとめてみました。

    「VBA ファイル ダウンロード」といったキーワード検索でのアクセスが…

  3. Office関連

    [Wordマクロ]PrintOutメソッド実行時に「型が一致しません」との実行時エラーが発生する。

    Wordマクロで文書を印刷するときはPrintOutメソッドをよく使い…

  4. Office関連

    指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ

    大量の画像ファイルを1枚/1スライドで挿入する必要があり、…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP