【WSH】相対パスのショートカット生成ツール

はじめに

昨年の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]ショートカットに相対パスを指定する。(その３)

ソースリスト

相対ショートカット作成.vbs

'相対パスのショートカット作成
'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」のあるフォルダ内に、相対パスに変更されたショートカットファイルが作成されます。

※アイコンは強制的にエクスプローラーのアイコンになります。アイコンを変更したい場合は、ショートカットのプロパティの「アイコンの変更」で変更してください。(但し、アイコンの参照元は絶対パスなので注意が必要です。)

ライセンスっぽいこと

• コード改変や配布は自由です。
• このツールによる義務／責任を何ら負いません。

最後に

大したツールではないですが、無いよりは有ったほうがいいかなと思います。

ショートカットも最初から相対パスを認めてくれればいいんですけどね。