面倒くさい省略URLの変換作業を一括処理する仕組みを作ってみました

どーもボキです。

この「エキサイトブログの記事に複数のYouTube動画を掲載する方法」で紹介したTinyURLを使えば、エキサイトブログに複数のYouTubeを掲載できます。

ただ、一つひとつ手作業でURLを変換するのはめんどくさい……。

APIがあるなら……、と思っていたら、ありました。

APIがあっても有料だろうしなぁ……、と思っていたら、無料で使えました。

無料でAPIが使えても調べるのがメンドウだ……、と思っていたら、やり方を書いたページを見つけました。

Rubyを使っているのか……、ボキ知らないんだよね……、と思っていたら、ChatGPTにお願いすれば一発でした。

いい世の中になったもんです。

なら、Excel VBAに仕込めるじゃん。早速、仕込んでみました。

サンプルプログラムのダウンロードと使い方

Short動画にも対応させてみました。

• ダウンロード
• 使い方は、YouTubeからURLコピーしてA列へ貼り付ける、だけ。
  エキサイトブログ用のHTMLタグをコピーすれば、HTML編集用のタグを取り出せます。ブラウザからURLをコピペすると、ページタイトルとそのURLをコピペできるので、URLを分離して処理させています。ちなみに、記事に貼れるYouTube動画を１つに限定しているのはエキサイトブログの制約です。エキサイトブログ以外でも適用も想定して、オリジナルURLのまま生成させたHTMLタグも用意しています。

超カンタン。

ただ……、TinyURLは無料アカウントで生成した短縮URLには数秒間の広告が入ります。ここを許容できるなら、超べんり！

TinyURLの無料アカウント変換したYouTube動画

【神回】もはやフルスクラッチ！旧キット1/100ガンダムを同スケールのジムとニコイチ改造したら理想の78ガンダムができた！？

【旧キット改造】1/100ガンキャノンをMGよりカッコよく徹底改造！コアファイター内蔵と可動とプロポーションの両立

【ガンプラ改造】旧キット1/100グフのイマイチな造形を往年のテクニックで劇的変化

今回開発したプログラムソース

以下のプログラムを、標準モジュールに貼りつければ、

• TinyUrlCreate …… 短縮URLを生成する関数
• GetLinkText …… 設定されたハイパーリンク先を文字列で取り出す関数

が使えるようになります。

Option Explicit

' TinyURLで短縮URLを作成して返す

Public Function TinyUrlCreate(ByVal longUrl As String) As String

Dim api As String

api = "https://tinyurl.com/api-create.php?url=" & longUrl

Dim http As Object

Set http = CreateObject("MSXML2.XMLHTTP")

http.Open "GET", api, False

http.setRequestHeader "User-Agent", "ExcelVBA"

http.send

If http.Status <> 200 Then

Err.Raise vbObjectError + 513, "TinyUrlCreate", _

"HTTP error: " & http.Status & " " & http.statusText

End If

TinyUrlCreate = Trim$(http.responseText) ' 例: https://tinyurl.com/yqp7ct

End Function

' ハイパーリンクのURLを取り出す

Function GetLinkText(rng As Range) As String

Dim url As String

Dim p As Long

If rng.Hyperlinks.Count = 0 Then

GetLinkText = ""

Exit Function

End If

url = rng.Hyperlinks(1).Address

' &t= があれば削除

p = InStr(url, "&t=")

If p > 0 Then

url = Left(url, p - 1)

End If

GetLinkText = url

End Function

にほんブログ村