【VBS】ショートカットファイルのリンク先を相対パスに書き換えるプログラム

以前にVB.NETで作ったものをVBSで作り直してみた。

 VBSはメモ帳に書いて拡張子を「.vbs」に変えるだけで動かせるから、セキュリティが強めな職場のネットワーク環境でも難なく動かすことができる。

これを「SendTo」フォルダに入れれば気軽にショートカットファイルを相対パスのショートカットに変更することができるので、使えないこともないだろう。
例え使用頻度が低くても、逐一ネットでやり方を調べて相対パスのショートカットに書き換えるよりは早いので、持っておいて損はない。
頻度が低いならSendToフォルダに入れず適当な場所に置いておいて、ドラッグ＆ドロップで実行するてもあるだろう。

If WScript.Arguments.Count = 0 Then WScript.Quit

Dim sExt
Dim sLink
Dim sRelativePath
Dim arrPathFile()
Dim arrPathLink()
Dim WshShell
Dim ShellLink
Dim iMax

Set WshShell = CreateObject("WScript.Shell")

For i = 0 to WScript.Arguments.Count -1
	sExt = WScript.Arguments.Item(i)
	If UCase(Right(sExt,4)) = ".LNK" Then
		Set ShellLink = WshShell.CreateShortcut(sExt)
		sLink = ShellLink.TargetPath
		If Instr(sLink,"\explorer.exe") = 0 Then 
			
			ReDim arrPathLink(UBound(Split(sLink,"\")))
			For j = LBound(arrPathLink) to UBound(arrPathLink)
				arrPathLink(j) = Split(sLink,"\")(j)
			Next
			
			ReDim arrPathFile(UBound(Split(sExt,"\")))
			For j = LBound(arrPathFile) to UBound(arrPathFile)
				arrPathFile(j) = Split(sExt,"\")(j)
			Next

			iMax = UBound(arrPathLink)
			sRelativePath = ""

			For j = 0 to iMax
				If arrPathLink(j) = arrPathFile(j) Then
				Else

					For k = j to UBound(arrPathFile)
						sRelativePath = sRelativePath & "."
					Next
					
					For k = j to iMax
						sRelativePath = sRelativePath & "\" & arrPathLink(k)
					Next

					Exit For
				End If
			Next
			
			ShellLink.WorkingDirectory = ""
			ShellLink.TargetPath = "%windir% \explorer.exe"
			ShellLink.Arguments = """" & sRelativePath & """"
			ShellLink.Save
		End If
	End If
Next


Set WshShell = Nothing
Set ShellLink = Nothing

それにしてもコードを載せると一気に文字数が稼げるな！