ショートカットを書き換えるスクリプト

ファイルサーバが移行してファイルサーバのパスが変わったとか理不尽なことをいわれたので
ショートカットを書き換えるスクリプトを書いた。
書き方がVBSっぽくないのはきにしちゃだめ。

使い方

L3.4の "\\beforeserver\share"　が　"\\afterserver\share"　に変わることになるので必要に応じて書き換えて下さい。

以下ソースを任意のフォルダに「ショートカット書き換え.vbs」などの名前で保存をして書き換えたいショートカットを複数選択してドラッグアンドドロップしてください。
ファイルを置き換えるので事前にバックアップを取っておくことをオススメします。

Option Explicit
 
'ここを書き換える
Const OLD_LINK = "\\beforeserver\share"
Const NEW_LINK = "\\afterserver\share"
 
Call Main()
 
Private Sub Main()
   Dim objFileSys
   Dim filePath
    
   Set objFileSys = CreateObject("Scripting.FileSystemObject")
    
   For Each filePath In WScript.Arguments
      If objFileSys.GetExtensionName(filePath) = "lnk" Then
         Call Rewrite(filePath, objFileSys)
      End If
   Next
   Wscript.Echo "完了"
    
End Sub

Function Rewrite(filePath, objFileSys)
   On Error Resume Next
 
   Dim wshShell
   Dim targetShortcut
   Dim targetPath
   Dim newLink
    
   set wshShell = CreateObject("WScript.Shell")
   set targetShortcut = wshShell.CreateShortcut(filePath)
   targetPath = targetShortcut.TargetPath
  
   If UCase(Left(targetPath,Len(OLD_LINK))) = UCase(OLD_LINK) Then
      newLink = Replace(targetPath,OLD_LINK,NEW_LINK,1,1,1)
      objFileSys.DeleteFile filePath
      set targetShortcut = wshShell.CreateShortcut(filePath)
      targetShortcut.TargetPath = newLink
      targetShortcut.Save()
      'Wscript.Echo "書き換えたよ" + targetShortcut.TargetPath
   End If
   If Err <> 0 Then
      WScript.Echo "PATH:" & filePath & " [" & Err.Number & "][" & Err.Description & "]"
   End If
End Function

注意点

当初ネットに転がっていたものを流用しようとしたのだが、Win7ではうまく動かなかったので
ショートカットを一旦削除して再作成するように変更した。
また再作成しているが、引き継いでいるのは「TargetPath」だけなので作業フォルダとかショートカットとか設定している場合は消えてしまうので注意が必要。