はじめに
昨年のVisual Basic Advent Calendar 2015用に別ブログに書いた記事を再構成したものです。当時、間に合わなかったツールを遅ればせながら作成しました。
経緯
お仕事で、お客様のサーバーの共有フォルダにシステム導入用ファイル群を置いた際、分かりやすいように実行ファイルのショートカットを作成しておいたのです。
次の日の通勤中の車の中で、システム導入用ファイル群はローカルフォルダにコピーしてから使用するので、ショートカットでは絶対パスになっているから意味がないことに気がついたのです。出社するやいなや、ショートカットを実行しないように連絡しました。
そもそも相対パスのショートカットって出来るのかと、早速ネットで検索し「ショートカットで指定するパスを相対パスで指定する方法」を見つけましたが、面倒そうです。
これならば、絶対パスのショートカットをドラッグ＆ドロップしたら、相対パスのショートカットにする変換するツールをWSH(VBScript)で作成すれば便利かも知れないと思って作り始めました。
相対パスのショートカットの仕組み
ショートカットは通常は絶対パスになっており、残念ながら単純に相対パスに書き換えただけでは動作しません。
コマンドを付与した上で相対パスを指定する必要があります。
-
引数が無い場合
%windir%\explorer.exe "相対パス"
または
%windir%\system32\rundll32.exe url.dll,FileProtocolHandler "相対パス"
※作業フォルダーは空白にする。 -
引数を指定する場合
%windir%\system32\cmd.exe /c start "%cd%" "相対パス" [引数...]
※作業フォルダーは空白にする。
参照：
[Windows Script Programming]ショートカットに相対パスを指定する。(その２)
[Windows Script Programming]ショートカットに相対パスを指定する。(その３)
ソースリスト
'相対パスのショートカット作成
'On Error Resume Next
Const MINIMIZE_WINDOW = 7
Dim objShell, shellLink, res, reg, objArgs, input
Set objShell = WScript.CreateObject("WScript.Shell")
'引数取得
Set objArgs = WScript.Arguments
If IsShortCut(objArgs(0)) = True Then
Set shellLink = objShell.CreateShortcut(objArgs(0))
input = objArgs(0)
If shellLink.Arguments <> "" Then
input = input & " " & shellLink.Arguments
End If
res = InputBox("相対パスに修正してください。","相対パス入力", Replace(input, " - ショートカット.lnk", ""))
If res <> "" Then
Call UpdateShortCut(res, shellLink.Arguments)
MsgBox("完了しました。")
Else
MsgBox("キャンセルしました。")
End If
Else
MsgBox("対象外のファイルです。")
End If
Set objShell = Nothing
Set shellLink = Nothing
'ショートカットかどうかの判定
Function IsShortCut(strFile)
If UCase(Right(strFile, 4)) = ".LNK" Then
IsShortCut = True
Else
IsShortCut = False
End If
End Function
'ショートカットの書き換え
Function UpdateShortCut(relativePath, arguments)
'On Error Resume Next
Dim fso, saveFile, target, arg
Set fso = CreateObject("Scripting.FileSystemObject")
saveFile = fso.getParentFolderName(WScript.ScriptFullName)
saveFile = saveFile & "\" & fso.GetFileName(objArgs(0))
Set shellLink = objShell.CreateShortcut(saveFile)
Set fso = Nothing
If arguments = "" Then
target = "%windir%\explorer.exe"
arg = relativePath
Else
target = "%windir%\system32\cmd.exe"
arg = " /c start " & """%cd%""" & " " & relativePath
shellLink.WindowStyle = MINIMIZE_WINDOW
End If
shellLink.TargetPath = target
shellLink.Arguments = arg
shellLink.WorkingDirectory = ""
shellLink.IconLocation = "%windir%\explorer.exe,0"
shellLink.Save
'エラー処理
If Err <> 0 Then
WScript.Echo Err.Number & " : " & Err.Description
End If
End Function
使用方法
1.上記ソースリストを「相対ショートカット作成.vbs」(名前は変更可能)で作成し、任意フォルダに保存します。
2. 通常のショートカットファイルを作成する。
3. 「相対ショートカット作成.vbs」 に、2で作成したショートカットファイル(拡張子:LNK)をドラッグ＆ドロップします。
4. 入力画面「相対パスに修正してください。」の初期値に「絶対パス (引数)」がセットされているので、相対パスに変更してOKボタンをクリックします。
5. 「相対ショートカット作成.vbs」のあるフォルダ内に、相対パスに変更されたショートカットファイルが作成されます。
※アイコンは強制的にエクスプローラーのアイコンになります。アイコンを変更したい場合は、ショートカットのプロパティの「アイコンの変更」で変更してください。(但し、アイコンの参照元は絶対パスなので注意が必要です。)
ライセンスっぽいこと
- コード改変や配布は自由です。
- このツールによる義務／責任を何ら負いません。
最後に
大したツールではないですが、無いよりは有ったほうがいいかなと思います。
ショートカットも最初から相対パスを認めてくれればいいんですけどね。