VBS ショートカットを一括編集

Option Explicit
Const OldHost = ""    '変更前
Const NewHost = ""    '変更後
Call Main()
    Sub Main()
        Dim objFS
        Dim objShell
        Dim Path
            'デスクトップのファルダパスを取得します。
            Set objShell = CreateObject("WScript.Shell")


	    '※※※↓を対象フォルダに変更※※※
            Path = ""
	    '※※※↑を対象フォルダに変更※※※



            'FileSystemObjectを生成します。
            Set objFS = CreateObject("Scripting.FileSystemObject")
            'ショートカット書き換え処理を呼び出します
            ShortCutPathReplace objFS.GetFolder(Path)
            'オブジェクトを破棄します。
            Set objFS = Nothing
            Set objShell = Nothing
    
            msgbox "ショートカットファイルのリンク先変更が完了しました。"
    End Sub
    '引数で渡されたフォルダのパスとその配下のサブフォルダ全てを再帰的に走査し、
    'ショートカットファイルのリンク先を書き換えます。
    Sub ShortCutPathReplace(ByVal objBaseFolder)
        Dim objFS
        Dim objSubFolder
        Dim objFile
        Dim objShell
        Dim objShellLink
        Dim ShortCutPath
        Dim WorkDirPath
            'オブジェクトを生成します。
            Set objFS = CreateObject("Scripting.FileSystemObject")
            Set objShell = CreateObject("WScript.Shell")
            'サブフォルダを再帰的に走査します。
            For Each objSubFolder In objBaseFolder.SubFolders
                ShortCutPathReplace objSubFolder
            Next
            'フォルダ内の全てのファイルを走査します。
            For Each objFile In objBaseFolder.files
                'ファイルパスの拡張子を判定します。
                If objFS.GetExtensionName(objFile.Path) = "lnk" Then
                    'ショートカットのオブジェクトを生成します。
                    Set objShellLink = objShell.CreateShortcut(objFile.Path)
                    'ショートカットのリンク先を取得します。
                    ShortCutPath = objShellLink.TargetPath
                    '作業フォルダのパスを取得します。
                    WorkDirPath = objShellLink.WorkingDirectory
                    On Error Resume Next
                        'ショートカットのリンク先が書き換え対象かを判定します。
                        If Left(ShortCutPath,Len(OldHost)) = OldHost Then
                            'リンク先パスを書き換えます。
                            objShellLink.TargetPath = Replace(ShortCutPath,OldHost,NewHost)
                            'リンク先の変更を保存します。
                            objShellLink.Save
                        End If
                        'ショートカットの作業フォルダが書き換え対象かを判別します。
                        '※ショートカットがフォルダの場合は作業フォルダは空なのでIFの判定でFalseになり無視されます。
                        If Left(WorkDirPath,Len(OldHost)) = OldHost Then
                            objShellLink.WorkingDirectory = Replace(WorkDirPath,OldHost,NewHost)
                            '作業フォルダの変更を保存します。
                            objShellLink.Save
                        End If
                    'エラー処理
                    If Err.Number <> 0 Then
                        'エラーが出た場合は、msgboxで通知してエラー対象のショートカットファイルを通知
                        msgbox "以下のショートカットファイルのリンク先書き換え処理でエラーが発生しました。" _
                            & vbcrlf & vbcrlf & objFile.Path
                    End If
                    'エラーを初期化
                    On Error Goto 0
                End If
            Next
            'オブジェクトを破棄します。
            Set objFile = Nothing
            Set objSubFolder = Nothing
            Set objShellLink = Nothing
            Set objFS = Nothing
            Set objShell = Nothing
    End Sub