前回の、Googleドライブにある画像の直リンク取得だが、
使用回数重ねるうちに思ったのは、いちいちダイアログからコピーするのが
億劫だってこと。
修正自体はリザルト先を入力ダイアログからクリップボードへ
変えるだけだし一先ず直してみる。
とは言え、これで使い易くなるのかどうかピンと来ないんだけども…。
尚、VBSでクリップボードへのコピーはここを参考にした。
clipコマンドを利用してクリップボードに文字列をコピーするVBScript | 初心者備忘録
動作はclipコマンドを使い実現しているので、
扱う文字列にコマンドプロンプトのエスケープ文字「 "|<>&」が
入り込まないことが約束されている場合のみ取り入れると良さ気。
仮にエスケープ文字を含む文字列をクリップボードにコピーしたいなら、
InternetExplorerオブジェクトを使ったこちらの解説が役立つだろう
(ソース見ると分かるが、力技なアプローチ。)。
●操作手順
1.Googleドライブにある画像を右クリック 2.「共有可能なリンクを取得」から表示されるリンクを選択してCtrl+Cでコピー 3.VBSを実行して直リンクをクリップボードへセット 4.クリップボードにコピーされた直リンクを貼り付ける等して使用
GoogleDriveCreatePermalink.vbs
Option Explicit Const TITLE = "Googleドライブ画像、直リンク生成" Const VERSION = "Ver1.10" Const RELEASE = #2017/04/30# Const AUTHOR = "REGEKATSU" '元URL Const SEARCH_TEXT = "https://drive.google.com/open?id=" '加工URL Const REPLACE_TEXT = "https://drive.google.com/uc?id=" '完了メッセージ表示時間(秒) Const WAIT_TIME = 5 Dim clipText Dim putText 'クリップボードのテキストデータを確認する clipText = GetClipboardText() 'クリップボードが空なら終了する If IsNull(clipText) Then WScript.Echo "貼り付けるデータがありません。" & vbCrLf & _ "とりあえず、何かコピーしてください。。。" WScript.Quit 'クリップボードに共有リンクが含まれていなければ終了する ElseIf InStr(clipText, SEARCH_TEXT) <= 0 Then WScript.Echo "貼り付けるデータが正しくありません。" & vbCrLf & _ "共有可能なリンクを取得からコピーしてください。。。" WScript.Quit End If 'Googleドライブ内画像の共有可能なリンクから直リンクを生成する putText = Replace(clipText, SEARCH_TEXT, REPLACE_TEXT) 'クリップボードへテキストデータをセットする SetClipboardText putText '完了メッセージを一定時間表示する CreateObject("WScript.Shell").Run _ "cmd /c echo " & TITLE & " " & VERSION & " & " & _ "echo 共有可能なリンクから直リンクを生成しました。 & " & _ "echo 直リンク: " & putText & " & " & _ "echo; & " & _ "echo ※この画面は " & WAIT_TIME & " 秒後に閉じます... & " & _ "ping -n " & WAIT_TIME & " localhost > nul", 1 WScript.Quit 'サブルーチン 'クリップボードのテキストデータを取得する。なければNullを返す。 Function GetClipboardText() Dim objHTML Set objHTML = CreateObject("htmlfile") GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text")) Set objHTML = Nothing End Function 'クリップボードへテキストデータをセットする。 Sub SetClipboardText(ByVal str) Dim cmd cmd = "cmd /c ""echo " & str & "| clip""" CreateObject("WScript.Shell").Run cmd, 0, True End Sub