ReCreateShortcuts.vbs

'
' ReCreateShortcuts.vbs
' 
' Copyright (c) 2016 amdkkj
' This software is released under the MIT License.
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to deal
' in the Software without restriction, including without limitation the rights
' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
' 
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
' 
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.

Option Explicit

Dim objShell
Set objShell = CreateObject("WScript.Shell")

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

Function IsShortcutPath(strShortcutPath)
  IsShortcutPath = (LCase(Right(strShortcutPath, 4)) = ".lnk")
End Function

Function Shortcut(strShortcutPath)
  Set Shortcut = objShell.CreateShortcut(strShortcutPath)
End Function

Sub EchoMessageWithShortcut(strMessage, strShortcut)
  Wsh.Echo strMessage & vbCrLf & vbCrLf & strShortcut
End Sub

Sub ReCreateShortcut(objShortcut)
  Dim strArguments:        strArguments        = objShortcut.Arguments
  Dim strDescription:      strDescription      = objShortcut.Description
  Dim strFullName:         strFullName         = objShortcut.FullName
  Dim strHotkey:           strHotkey           = objShortcut.Hotkey
  Dim strIconLocation:     strIconLocation     = objShortcut.IconLocation
  Dim strTargetPath:       strTargetPath       = objShortcut.TargetPath
  Dim lngWindowStyle:      lngWindowStyle      = objShortcut.WindowStyle
  Dim strWorkingDirectory: strWorkingDirectory = objShortcut.WorkingDirectory
  
  On Error Resume Next

  Err.Number = 0
  objFSO.DeleteFile objShortcut.FullName
  If Err.Number <> 0 Then
    EchoMessageWithShortcut Err.Description, objShortcut
    Exit Sub
  End If

  Set objShortcut = objShell.CreateShortcut(strFullName)
  objShortcut.TargetPath       = strTargetPath
  objShortcut.Arguments        = strArguments
  objShortcut.Description      = strDescription
  objShortcut.Hotkey           = strHotkey
  objShortcut.IconLocation     = strIconLocation
  objShortcut.WindowStyle      = lngWindowStyle
  objShortcut.WorkingDirectory = strWorkingDirectory
  
  objShortcut.Save
End Sub

If Wscript.Arguments.Count >= 1 Then
  If MsgBox("ショートカットファイルを再作成します。", vbOkCancel) <> vbOK Then
    Wsh.Quit
  End If
  
Else
  Wsh.Echo "再作成したいショートカットファイル (*.lnk) を指定してください。"
  Wsh.Quit
End If

Dim nI
Dim strArgument
For nI = 0 To (WScript.Arguments.Count - 1)
  strArgument = Wscript.Arguments(nI)

  If IsShortcutPath(strArgument) Then
    RecreateShortcut Shortcut(strArgument)
  Else
    EchoMessageWithShortcut "スキップ: ショートカットファイル (*.lnk) ではありません。", strArgument
  End If
Next

Wsh.Echo "完了"

※エンコーディングをShift JIS に変更する必要あり。