On Error Resume Next
'替换某文件夹及其子文件夹下的所有快捷方式的指向路径
strFolderPath="D:\Program Files\TrueLaunchBar\Shortcut\File\ Style" '快捷方式的路径
strToReplace="\SOFTWARE\" '被替环的字符串
strReplace="\[Software]\" '替换成的字符串
Set wshShell = CreateObject("Shell.Application")
Set wshFSO = CreateObject("Scripting.FileSystemObject")
AlterSubFolders wshFSO.GetFolder(strFolderPath)
Sub AlterSubFolders(Folder)
Set npFolder = wshShell.Namespace (Folder.Path)
Set allFiles=Folder.Files
For Each lnkFile In allFiles
'Wscript.Echo lnkFile.Name
If InStrRev(UCase(lnkFile.Name), ".LNK") <> 0 Then '扩展名是否快捷方式
Set lnkItem = npFolder.ParseName(lnkFile.Name)
Set lnkItemLink = lnkItem.GetLink
'Wscript.Echo """"&lnkItemLink.Path&""""
lnkItemLink.Path = Replace("""" & lnkItemLink.Path & """",strToReplace,strReplace)
lnkItemLink.WorkingDirectory = Replace("""" & lnkItemLink.WorkingDirectory & """",strToReplace,strReplace)
lnkItemLink.Save()
End If
Next
For Each Subfolder in Folder.SubFolders
'Wscript.Echo "Folder" & Subfolder.Path
Set npFolder = wshShell.Namespace (Subfolder.Path)
Set objFolder = wshFSO.GetFolder (Subfolder.Path)
Set allFiles = objFolder.Files
For Each lnkFile in allFiles
If InStrRev(UCase(lnkFile.Name), ".LNK") <> 0 Then '扩展名是否快捷方式
Set lnkItem = npFolder.ParseName(lnkFile.Name)
Set lnkItemLink = lnkItem.GetLink
'Wscript.Echo """"&lnkItemLink.Path&""""
lnkItemLink.Path = Replace("""" & lnkItemLink.Path & """",strToReplace,strReplace)
lnkItemLink.WorkingDirectory = Replace("""" & lnkItemLink.WorkingDirectory & """",strToReplace,strReplace)
lnkItemLink.Save()
End If
Next
AlterSubFolders Subfolder
Next
End Sub