返回列表 回复 发帖

VBS修改快捷方式路径

  1. Option Explicit
  2. Dim oldpath,newpath
  3. oldpath = "x:\game"           '设置原路径中将被替换的内容
  4. newpath = "g:\game\langame"   '设置新路径中要使用的内容
  5. Dim Wsh,fso
  6. Set Wsh = WScript.CreateObject("WScript.Shell")
  7. Set fso = CreateObject("Scripting.FileSystemObject")
  8. Dim ji_1,ji_2,Folder
  9. ji_1 = 0
  10. ji_2 = 0
  11. Folder = Wsh.CurrentDirectory
  12. if Ask("将要修改"&chr(34)& Folder &chr(34)&"里的所有快捷方,是否继续") then
  13.     Dim f,fc,f1,ext
  14.     Set f = fso.GetFolder(Folder)
  15.     Set fc = f.Files
  16.     For Each f1 in fc
  17.        ext = LCase(fso.GetExtensionName(f1))
  18.        if ext = "lnk" then
  19.           ji_1 = ji_1 + 1
  20.           call Doit(f1)
  21.        end if
  22.     Next
  23. end if
  24. Set WSH = Nothing
  25. msgbox "找到 "&ji_1&" 个快捷方式"&vbCrLf&"修改 "&ji_2&" 个快捷方式",64,"执行完毕"
  26. WScript.quit
  27. Sub Doit(strlnk)
  28. Dim oShlnk
  29.     Set oShlnk = Wsh.CreateShortcut(strlnk)
  30. If Instr(oShLnk.TargetPath,oldpath) > 0 Then
  31.         oShLnk.TargetPath = Replace(oShLnk.TargetPath,oldpath,newpath)
  32.         oShLnk.Save
  33.         ji_2 = ji_2 + 1
  34. End If
  35.     Set oShLnk=NoThing
  36. End Sub
  37. Function Ask(strAction)
  38.     Dim intButton
  39.     intButton = MsgBox(strAction,vbQuestion + vbYesNo,"询问")
  40.     Ask = intButton = vbYes
  41. End Function
复制代码
感谢Baidu,Google,Dreams8给我这次机会!
还要感谢我的爸爸妈妈!
HOHO
返回列表