CODE: [Copy to clipboard]
' 要处理的文件夹,如果是 "" 则代表当前文件夹。
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