中国DOS联盟

' 要处理的文件夹，如果是 "" 则代表当前文件夹。
Folder = ""

' 替换之前和之后的路径格式，这里采用正则表达式，可适应各种复杂的变换方式。
' 本程序只会修改符合指向路径格式符合 OldPathFormat 的快捷方式。
OldPathFormat = "^(D\:\\应用软件\\)(.*)$"
NewPathFormat = "E:\应用\$2"


Set objFSO = CreateObject("Scripting.FileSystemObject")
If Folder = "" Then Folder = objFSO.GetFile(WScript.ScriptFullName).ParentFolder
ChangeFilesUnderTheFolder Folder



' 处理文件夹下(不含子文件夹)所有的 .lnk 快捷方式文件
Function ChangeFilesUnderTheFolder(TheFolder)
        With objFSO.GetFolder(TheFolder)
                For Each Subfile in .Files
                        If LCase(Right(Subfile.Name, 4)) = ".lnk" Then
                                ChangeShortcutTargetPath(Subfile.Path)
                        End If
                Next
        End With
        MsgBox "文件夹 “" & TheFolder & "” 下所有快捷方式文件(除了提示不能修改的)已处理完毕！", 4160, "完成"
End Function


' 修改快捷方式文件的指向
Function ChangeShortcutTargetPath(ShortcutFile)
        On Error Resume Next
        With CreateObject("WScript.Shell").CreateShortCut(ShortcutFile)
                .TargetPath = ConvertTargetPath(.TargetPath, OldPathFormat, NewPathFormat)
                .Save               
        End With
        If Err.Number<>0 Then
                MsgBox "不能修改 “" & ShortcutFile & "” 的指向！", 4112, "错误"
                Err.Number = 0
        End If
End Function


' 将旧的路径替换成新的路径(如果不符合定义的格式则不替换)
Function ConvertTargetPath(OldTargetPath, OldPattern, NewPattern)
        Dim tempStr
        Set regEx = New RegExp
        regEx.Pattern = OldPattern
        If regEx.Test(OldTargetPath) Then
                tempStr = regEx.Replace(OldTargetPath, NewPattern)
        Else
                tempStr = OldTargetPath
        End If
ConvertTargetPath = tempStr
End Function