まだ書いてなかったブログ ~Not-Yet-Written~

今日も書き忘れそうだった雑記

エクセルVBAマクロを使って、Google MAPなど長い複数のURLを一度に短縮する方法

VBAで短縮URLに変換する関数を定義

長いURLを短縮するマクロ

今日はエクセルで短縮URLを作るマクロを組んでみました。

Googleマップなどのリンクをそのまま貼り付けてしまうとめちゃくちゃ長くなってしまいますね。

例:GoogleMAPの大阪城のリンク
https://www.google.co.jp/maps/place/大阪城/@34.6873153,135.5240126,17z/data=!3m1!4b1!4m5!3m4!1s0x6000e0cd5c283afd:0xf01d07d5ca11e41!8m2!3d34.6873153!4d135.5262013


例:Google マップ自由の女神リンク
https://www.google.co.jp/maps/place/自由の女神像/@40.6892494,-74.0466891,17z/data=!3m1!4b1!4m5!3m4!1s0x89c25090129c363d:0x40c6a5770d25022b!8m2!3d40.6892494!4d-74.0445004


特に気にならないようであれば良いですが、パワーポイントやワードなどのビジネス資料に記載するときに、長いのはカッコ悪かったり、スペース的に書ききれなかったりしたときにBitlyなどの短縮URLは便利です。

このとき、Bitlyサイトで1つ1つ長文リンクを短縮URLに変換しても良いですが、複数の長文リンクを短縮しなければならないとき1回1回、コピペを繰り返すことさえめんどくさい・・・

エクセルのマクロを使って、Bitlyの短縮URLに変換するためのエクセル関数を新しく作りました。

Bitly短縮URL変換するためのエクセル関数を定義するのに必要なもの

まず、そのマクロに必要なものは以下の2つです。

①Bitlyのアカウント名(LOGIN)
②BitlyのAPI KEY

①のBitlyのアカウントは各自取得して下さい。

 Bitly:https://bitly.com/

②のBitlyのAPIキーを取得する方法は次の手順です。

1.BitlyにログインしてSettingをクリック

Bitly Setting

2.次にSettingsをクリック

f:id:t-dicek:20161222223431p:plain

3.さらにAdvanced Settingsをクリック

Bitly_Advanced Settings

4.さらにAPI Supportをクリック

bitly_APISupport

5.LOGINとAPIKEYをコピペしておく

 Setting → Settings → Advanced Settings → API Supportの順にクリックすると、アカウント名(LOGIN)とAPI KEYが表示されます。APIKEYはR_から始まる文字列です。こちらの二つをメモ帳などにコピペして下さい。

BItly_LOGINとAPIKEY

エクセルVBAでBitly変換関数の定義する

エクセルのマクロを使ってBitlyの短縮URLを生成するためのマクロを組みます。ちなみにエクセル2013を使用しています。確認していませんが、2013以前のverでも使えると思います。

エクセルを起動させてAlt+F11を押してVBAの編集画面が開きます。

標準モジュールを選択して、以下のVBAコードを貼りつけます。ここで、適宜自分のアカウント名とAPIKEYに書き変えて下さい。※コピペOK

VBAコード
Function bitlyURL(txt As String) As String
    ' base on http://www.jpsoftwaretech.com/shorten-urls-with-bit-ly-web-api-and-vba/
    ' based on http://code.google.com/p/bitly-api/wiki/ApiDocumentation
    Dim xml As Object
    Dim myUserName As String, myApiKey As String
    Dim ApiTarget As String

    myUserName = "******"******のところをアカウント名に置き換えて下さい。
    myApiKey = "R_*******" ’******のところを自分のAPIKEYのR_以降を置き換えて下さい。

    ApiTarget = "http://api.bit.ly/shorten?version=2.0.1&format=text&login=" & myUserName _
        & "&apiKey=" & myApiKey & "&longUrl=" & txt

    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
    xml.Open "POST", ApiTarget, False
    xml.Send

     bitlyURL = xml.responsetext
End Function

実際にはこんな感じです。

エクセルBitly短縮URLマクロ

bitly短縮URL関数がきちんと動くか動作テスト

実際に、以上のマクロを動作させて長ったらしいリンクをGoogleMapのリンクを短縮させてみます。

1.B列にリンクを貼りつける

B列にリンクを貼る

短縮したいリンクをB列に貼り付けました。※B列に限定しているわけではありません。

2.C2に関数=bitlyURL(B2)を作成

関数bitlyURL()を記入

関数の()にセルB2を指定

3.後はドラッグでC列にコピーを作るだけ

ドラッグでbitlyURLを子ピー

B列に記載されたリンクがC列でBitlyの短縮URLに変換されていきますね。ドラッグしたセルをチェックしました。ちゃんとコピーされてますね。

ちゃんとbitlyURLコピペできてますね

4.リンクが変換されているかチェック。

それでは、短縮されたリンクで正確に元のURLに飛ぶことができるのかをチェック。
試しにリンクをクリックしてみてください。元の長いリンクと短縮リンクで同じページに飛べます。

例3:エッフェル塔

元の長いリンク
https://www.google.co.jp/maps/place/Eiffel+Tower/@48.8583736,2.2922926,17z/data=!3m1!4b1!4m5!3m4!1s0x47e66e2964e34e2d:0x8ddca9ee380ef7e0!8m2!3d48.8583701!4d2.2944813

短縮されたリンク
http://bit.ly/2if73qe


いかがですか?

処理時間も30個ぐらいであればストレスなくできました。これですっきりとしたリンクが作れますね。