Office関連

goo.glで短縮URLを取得するVBAマクロ

何年か前にHPで「goo.glで短縮URLを取得する」マクロを紹介しました。

人力検索はてなに「長い複数のURLを一度に短縮する方法はないでしょうか」という質問があり、上記記事へのリンクが貼られていたのですが、質問者さんの環境では実行できていないようでした。

私の方でも試してみたのですが、たしかに短縮URLが取得できなくなっています。

そこで、通信時のレスポンスを調べてみると、403エラー(Daily Limit for Unauthenticated Use Exceeded. Continued use requires signup.)が返ってきていました。
非承認時の上限超えのようです。いつの間にかURL Shortener APIもAPIキーが必要になっていたみたいですね。

ならば話は簡単で、APIキーを含めてリクエストを投げてやれば良さそうです。

Google APIキーの取得方法

※ 要Google アカウント

  1. Google アカウントでログインした状態で「Google Developers Console」にアクセスします。
  2. プロジェクトの作成」ボタンをクリックします。
  3. GoogleURLShortenerAPI_VBA_01

  4. プロジェクト名を適当に入力し「作成」ボタンをクリックします。
  5. GoogleURLShortenerAPI_VBA_02

  6. プロジェクトが作成されたら「APIと認証」から「API」をクリックします。
  7. GoogleURLShortenerAPI_VBA_03

  8. 検索ボックスに「URL」と入力し、ヒットした「URL Shortener API」をクリックします。
  9. GoogleURLShortenerAPI_VBA_04

  10. URL Shortener API画面が開かれたら「APIを有効にする」ボタンをクリックします。
  11. GoogleURLShortenerAPI_VBA_05

    GoogleURLShortenerAPI_VBA_06

  12. APIが有効になったら「APIと認証」から「認証情報」をクリックします。
  13. GoogleURLShortenerAPI_VBA_07

  14. 認証情報画面が開かれたら「公開 API へのアクセス」から「新しいキーを作成」ボタンをクリックします。
  15. GoogleURLShortenerAPI_VBA_08

  16. 新しいキーの作成ダイアログが表示されたら「ブラウザキー」ボタンをクリックします。
  17. GoogleURLShortenerAPI_VBA_09

  18. ブラウザキーの作成と許可対象リファラーの設定ダイアログが表示されたらテキストエリアを空欄にしたまま「作成」ボタンをクリックします。
  19. GoogleURLShortenerAPI_VBA_10

  20. APIキーが作成されたら、表示された「API キー」をメモ帳にでもコピーしておきます。
  21. GoogleURLShortenerAPI_VBA_11

これでAPIキーを入手することができました。
あとはVBAコード(上で紹介している記事のコードから若干変更しました)にAPIキーを入れてやればマクロ完成です。

'標準モジュール
Public Function GetShortenURL(ByVal TargetURL As String) As String
'Google URL Shortener APIを使って短縮URLを取得
  Dim dat As Variant
  Dim js As String, ret As String
  Dim d As Object, elm As Object
  Const API_KEY As String = "(APIキー)"
  
  js = "": ret = "" '初期化
  dat = "{""longUrl"": """ & TargetURL & """}"
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", "https://www.googleapis.com/urlshortener/v1/url?key=" & API_KEY, False
    .SetRequestHeader "Content-Type", "application/json"
    .Send dat
    Select Case .Status
      Case 200: js = .ResponseText
      Case Else: ret = "Error:" & .Status
    End Select
  End With
  If Len(Trim(js)) > 0 Then
    js = "(" & js & ")"
    Set d = CreateObject("htmlfile")
    Set elm = d.createElement("span")
    elm.setAttribute "id", "result"
    d.appendChild elm
    d.parentWindow.execScript "document.getElementById('result').innerText=eval(" & js & ").id;"
    ret = elm.innerText
  End If
  GetShortenURL = ret
End Function

上記コードは標準モジュールに書くと、ワークシート上からも呼び出せて便利だと思います。

GoogleURLShortenerAPI_VBA_12

関連記事

  1. Office関連

    ExcelのWebクエリからのアクセス情報

    mougに面白い質問がありました。・Querytables.a…

  2. Office関連

    シート見出しの右クリックメニューから「コードの表示」を消す方法

    いつもお世話になっている「インストラクターのネタ帳」の管理人である伊藤…

  3. Office関連

    オフライン版のOffice 2016 VBAリファレンスが公開されました。

    「ヘルプファイル版のOffice 2013開発者用リファレンスが公開さ…

  4. Office Scripts

    Office Scripts機能によってWeb版Officeの操作を自動化する

    前回、Ignite 2019で発表されたPower Automate(…

  5. アイコン一覧

    Office 2013 アイコン一覧(K,L)

    ・Office 2013 アイコン一覧 NUM…

コメント

  • コメント (8)

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

    • 初心者以下
    • 2016年 6月 01日

    APIキー取得済み。
    エクセル2013にて実行。
    やったこと①
    ・エクセルで標準モジュールを作成後、上記のプログラムを放り込んで”(APIキー)”の所に自身のキーを記入。
    結果、開発→マクロで実行しようにも何も表示されない。

    ・エクセルのシートタブの上で右クリック→コードの表示→VisualBasicEditorが開くので右側の大きな窓に上記コードを貼り付け、”(APIキー)”を記入後開発→マクロで実行しようにも何も表示されない。

    やったこと②
    何年か前にHPで「goo.glで短縮URLを取得する」マクロを紹介の先にあったマクロも上記①でやったことと同じ様に試しました。
    プログラム内の「key=” ‘APIキーがある場合」の<>を除外してAPIキーは組み込みました。
    結果としては、開発→マクロにマクロ名が表示されるんですが、長いURlの場所からマクロを実行しても何も変化はなしです。

    ・どうすれば使えるようになるのですか?
    ・APIキーは取得済みですが、上記の説明と現在のgoogleのアドレス先の状況に違いがあるので、正しくキーが取れているのか自信はありません。

    • > 初心者以下様

      当ブログ管理者のきぬあさです。
      お問い合わせいただきました短縮URL取得コードにつきまして、

      > ・エクセルで標準モジュールを作成後、上記のプログラムを放り込んで”(APIキー)”の所に自身のキーを記入。
      > 結果、開発→マクロで実行しようにも何も表示されない。

      当コードは下記のように短縮したいURLを引数として実行する必要があるため、「GetShortenURL」のコードを貼りつけただけでは、マクロダイアログから実行することが出来ません。
      (下記Sampleのように「GetShortenURL」を呼び出すマクロを用意する必要があります。)

      Public Sub Sample()
        MsgBox GetShortenURL("http://www.atmarkit.co.jp/")
      End Sub

      ただし、当コードを標準モジュールに貼りつけることで、ユーザー定義の自作関数として、ワークシートからも呼び出すことができるようになります。

      [参考Webページ]Excelでユーザー定義のワークシート関数を追加する
      http://www.atmarkit.co.jp/ait/articles/0406/12/news017.html

      > ・APIキーは取得済みですが、上記の説明と現在のgoogleのアドレス先の状況に違いがあるので、正しくキーが取れているのか自信はありません。

      Google Developers Consoleの仕様は度々変更されますが、キーの取得方法はこの記事で説明している方法と大体同じです。
      詳細については、(英語になってしまいますが)Googleのサポートページをご参照いただくのが良いかと思います。

      ・URL Shortener – Google Developers
      https://developers.google.com/url-shortener/?hl=ja
      ・Setting up API keys – Console Help
      https://support.google.com/cloud/answer/6158862

    • 初心者以下
    • 2016年 6月 02日

    おかげさまで、上手く組み込めました。

    すでに100カ所程、短縮とコピペを繰り返す手作業で飽き飽きしてた上、後200カ所もと考えるとやる気が失せてましたが、見事はかどりそうです。

    初めは長いアドレスの上でそのままマクロの実行をして、「短縮されるけどセルに書き込まない!!」と泣きそうになりましたが、「Getshorten(d2)」の部分をセルに書き込むと、目的通り出来ました。

    ありがとうございます。

    • タカオ
    • 2017年 4月 28日

    申し訳ありません。
    ユーザー定義のワークシート関数
    でGetShortenURLの関数が表示されて
    モジュールの中に追加されていると思いますが
    #Value!と表示されてしまいます。
    初心者以下様の事は全て試しました。
    もちろん、APIキーも取得済みです。
    Google API マネージャーもキャプチャより変わっている感じでしたが
    何とか取得しました。
    もしかして何か変わっていたらと思いまして・・・
    お暇な時にご確認頂けましたら幸いです。

    • > タカオ様

      当ブログ管理者です。
      ご質問いただいた件につきまして、私の方でも改めて確認したところ、特に問題無く短縮URLが取得できました。

      > モジュールの中に追加されていると思いますが
      > #Value!と表示されてしまいます。

      ワークシート上では無く、一度VBEからGetShortenURLを呼び出すマクロを作成して、動作確認を行った方が良いかと思います。

      また、APIの呼び出しが行われているかどうかを確認するため、GetShortenURL内の処理、たとえば「.Send dat」の下に「Debug.Print .Status, .ResponseText」なりを追加して、GoogleのAPIにデータ送信した際の結果がどのように返ってきているのかを確認することをお薦めいたします。
      何らかのメッセージが返ってくるのであれば、それにより原因が特定できるかもしれません。

  1. すいません、
    コメントを書いたのですが
    表示されていないようで
    投稿は送信されていますでしょうか。
    何度も申し訳ありません。

    • タカオ
    • 2017年 5月 02日

    何度も申し訳ありません。
    Mac OS Office 2011にて行っておりまして
    winにて行いましたらできました。
    ちなみに、Macのオフィスでこちらを動作させる方法はないでしょうか。

    • > タカオ様

      当ブログ管理者です。
      Office for Mac 2011は使用したことがないので分かりかねますが、下記Webページを見る限り、Windows版とは大きくことなるようですので、そのままマクロを使うことはできないでしょう。

      http://qiita.com/sjuny/items/d3bf8e4dd9e609374575

      MacScirptやdylibを使えば、もしかしたら似たような動作をするマクロが書けるかもしれませんが、残念ながら私の方では、その方法が分かりません・・・。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP