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を自由に呼び出せるので、なかなか遊び甲斐があるだろうと思います。

関連記事

  1. Office関連

    PowerShellからClosedXMLを使ってExcelファイルを作成する方法

    以前C#からClosedXMLを使ってExcelファイルを操作する方法…

  2. Office関連

    Wordのテンプレートをインストールするスクリプト

    Wordマクロをテンプレートにして使用する場合、通常そのテンプレートフ…

  3. Office関連

    フォルダ(サブフォルダ含む)内の特定の拡張子のファイルに処理を行うVBAマクロ

    「Wordマクロ サブフォルダ ファイル処理」といったキーワードでのア…

  4. アイコン一覧

    Office 2013 アイコン一覧(NUM)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

    PowerPoint 2013ではプレゼンテーションをmp4形式で保存できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  6. Office関連

    YouTube動画挿入アドイン for PowerPoint

    前回の記事でPowerPoint 2013でYouTubeの動画が挿入…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP