Amazon.co.jpの商品ページURLを短縮化するVBScript

Amazonの商品ページを短縮したい！

Amazonで見つけた商品を友人とかに共有するとき、どうしてますか？
昔は短縮URLを発行する機能があったのですが、今は廃止されてしまいました。（2020/03/06時点）

例えば、Apple AirPods ProのURLを送ろうとすると、

https://www.amazon.co.jp/Apple-アップル-MWP22J-A-AirPods/dp/B07ZPS4FSW/ref=sr_1_1_sspa?__mk_ja_JP=%E3%82%AB%E3%82%BF%E3%82%AB%E3%83%8A&keywords=apple&qid=1583476380&sr=8-1-spons&psc=1&spLa=ZW5jcnlwdGVkUXVhbGlmaWVyPUExNjRaNUlYSjNTNlJLJmVuY3J5cHRlZElkPUEwMTc4MDgzNzdDQzg1VllRUVA0JmVuY3J5cHRlZEFkSWQ9QTVISTFYUlM5S0RVSSZ3aWRnZXROYW1lPXNwX2F0ZiZhY3Rpb249Y2xpY2tSZWRpcmVjdCZkb05vdExvZ0NsaWNrPXRydWU=

このとおり。
長い。めちゃくちゃ長い。

そこでGoogle先生に聞いてみると、最短で https://amazon.co.jp/dp/B07ZPS4FSW/ まで短くなることが分かります。
短くなってすっきり！

でも、いちいち手でURL編集するのダルい…

VBScriptで作っちゃえ

ということで、簡単に短縮するツールを作ってしまえということで作りました。
Amazon（Japan）の長いURLをコピーしてクリップボードに入れ、VBScriptを起動させると、URLを短縮してクリップボードに入れなおしてくれるプログラムです。

VBScriptプログラム

amzn shorter.vbs

Option Explicit
Dim objRE
Dim objHTML
Dim objClip
Dim objREC
Dim WSH
Dim URL
Dim SURL
Dim PDCD

'クリップボードからテキスト抽出
Set objHTML = CreateObject("htmlfile")
URL = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))

'正規表現でAmazonの商品ページURLかを判断し、URL短縮化＋クリップボードに保存
Set objRE = CreateObject("VBScript.RegExp")
objRE.Pattern = "https://www.amazon.co.jp/.*dp/*"

If objRE.Test(URL) Then
  PDCD = Mid(URL, InStr(URL, "/dp/") + 4, 10)
  SURL = "https://amazon.co.jp/dp/" & PDCD & "/"

  Set WSH = CreateObject("WScript.Shell")
  Set objClip = WSH.Exec("clip")
  Set objREC = objClip.stdIn
  objREC.WriteLine SURL
  objREC.Close
  WScript.echo "Done."
Else
  WScript.echo "It's NOT the URL of the Amazon item page."
End If

Set objRE = Nothing
Set objHTML = Nothing
Set WSH = Nothing
Set objClip = Nothing
Set objREC = Nothing

使い方

1. Amazonの商品ページのURLをコピー
2. VBSファイルを起動
3. ［Done.］のメッセージが表示されたら完了
4. メールなどにペースト

使ってみてエラーが発生したり、もっと構文をコンパクトにできる方法があればコメントいただけると嬉しいです！

あとがき

VBScriptでクリップボードに保存させるところが本当に苦労しました…
VBAとかと同じくDataObjectでアクセスできるといいんだけど…