|
本帖最后由 tomggx 于 2024-12-23 22:42 编辑
我把 9zhmke 的代码补充完整一下,可以在桌面创建word/excel/powerpoint快捷方式:
Function Shortcut(Short_name,path_and_name)
Dim wshShell, objFSO
Set wshShell = Wscript.CreateObject("Wscript.Shell")
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
strDesktop = WshShell.SpecialFolders("AllUsersDesktop")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\_" & Short_name & ".lnk")
oShellLink.TargetPath = path_and_name
oShellLink.WindowStyle = 1
oShellLink.Hotkey = ""
oShellLink.IconLocation = path_and_name & ",0"
oShellLink.Description = Short_name
oShellLink.WorkingDirectory = left(path_and_name,InStrRev(path_and_name,"\"))
oShellLink.Arguments = ""
oShellLink.Save
set tmp1=createobject("adodb.stream"):tmp1.type=1:tmp1.open
tmp1.loadfromfile strDesktop & "\_" & Short_name & ".lnk"
line=tmp1.read:line=midb(line,1,21) & chr(int(ascb(midb(line,22,1)))+32) & midb(line,24,32766)
if objFSO.FileExists(strDesktop & "\" & Short_name & ".lnk") then objFSO.deletefile strDesktop & "\" & Short_name & ".lnk",true
tmp1.close:Set tmp2 = CreateObject("ADODB.Stream"):tmp2.Type=1:tmp2.Open
With CreateObject("ADODB.Stream")
.Type=2:.Open:.WriteText line
.Position=2:.CopyTo tmp2:.Close
End With
tmp2.SaveToFile strDesktop & "\" & Short_name & ".lnk",2:tmp2.Close
objFSO.deletefile strDesktop & "\_" & Short_name & ".lnk",true
End Function
Dim ret
ret = Shortcut("Word", "C:\Program Files (x86)\Office 2016\Office16\WINWORD.EXE")
ret = Shortcut("PowerPoint", "C:\Program Files (x86)\Office 2016\Office16\POWERPNT.EXE")
ret = Shortcut("Excel", "C:\Program Files (x86)\Office 2016\Office16\EXCEL.EXE") |
|