引用:Windows Script Host ...'创建快捷方式 Public Sub CreateShortCutOnDeskTop(ByVal Name As String, ByVal Description As String, TargetPath As String, WorkingDirectory As String) Dim X As New IWshRuntimeLibrary.IWshShell_Class Dim Y As IWshRuntimeLibrary.IWshShortcut_Class 'Attribute VB_Name = "ShortCut" Set Y = X.CreateShortcut(X.SpecialFolders.item("AllUsersDesktop") & "\" & Name & ".lnk") Y.TargetPath = TargetPath Y.Description = Description Y.WorkingDirectory = WorkingDirectory Y.Save End Sub
关于"快捷方式"的几个问题 (引用 Windows Script Host Model): 1.如何获取某一已存在的快捷方式(*.lnk)的所有信息? Dim x As New IWshRuntimeLibrary.IWshShell_Class Dim y As IWshRuntimeLibrary.IWshShortcut_Class Set y = x.CreateShortcut("..\..\XXX.lnk") Dim s As String s = "Arguments: " & y.Arguments & vbCrLf _ & "Description: " & y.Description & vbCrLf _ & "FullName: " & y.FullName & vbCrLf _ & "Hotkey: " & y.Hotkey & vbCrLf _ & "IconLocation: " & y.IconLocation & vbCrLf _ & "TargetPath: " & y.TargetPath & vbCrLf _ & "WindowStyle: " & y.WindowStyle & vbCrLf _ & "WorkingDirectory: " & y.WorkingDirectory MsgBox s 2.如何在 Windows 任务栏中创建快捷方式? Dim x As New IWshRuntimeLibrary.IWshShell_Class Dim y As IWshRuntimeLibrary.IWshShortcut_Class If VBA.Len(VBA.Trim(VBA.Dir(x.SpecialFolders.Item("AppData") & "\Microsoft\Internet Explorer\Quick Launch\"))) > 0 Then Set y = x.CreateShortcut(x.SpecialFolders.Item("AppData") & "\Microsoft\Internet Explorer\Quick Launch\WinRAR.lnk") y.TargetPath = "..\..\XXX.exe" y.Save End If '下面是几种 Windows 特殊路径: AllUsersDesktop AllUsersStartMenu AllUsersPrograms AllUsersStartup AppData Desktop Favorites Fonts MyDocuments NetHood PrintHood Programs Recent SendTo StartMenu Startup Templates 综上 CreateShortcut 是用来创建一个 WshShortcut 的对象, 只要不调用其 Save 方法,就不会真正改变快捷方式的属性。
'创建快捷方式 Sub CreateShortCuts() Dim WSH_Shell As WshShell Dim SCut As WshShortcut
Set WSH_Shell = New WshShell
Set SCut = WSH_Shell.CreateShortcut(TOUCHPATH & "\touch.lnk")
With SCut .TargetPath = TOUCHPATH & "\touch.exe" .WorkingDirectory = TOUCHPATH .Save End With
Set WSH_Shell = Nothing Set SCut = Nothing
Dim FileNumber As Integer
FileNumber = FreeFile
'pif快捷方式的第430字节为8,全屏幕运行 Open TOUCHPATH & "\touch.pif" For Binary As #FileNumber Put #FileNumber, 430, 8 Close #FileNumber
End Sub
'Ê×ÏÈÒªÒýÓÃWSH£¬Ñ¡VBµÄ²Ëµ¥Project->Reference£¬¼ÓÈëWindows Script Host Model¡£ Option ExplicitPublic Sub CreateShortCutOnDeskTop(ByVal Name As String, ByVal Description As String)Dim x As New IWshRuntimeLibrary.IWshShell_Class Dim y As IWshRuntimeLibrary.IWshShortcut_Class Set y = x.CreateShortcut(x.SpecialFolders.Item("AllUsersDesktop") & "\" & Name & ".lnk") '¿ì½Ý·½Ê½ÊôÐÔÖеÄÄ¿±ê y.TargetPath = App.Path & "\ÏîÄ¿¹ÜÀíϵͳ.exe" '¿ì½Ý·½Ê½ÊôÐÔÖеı¸×¢ y.Description = Description '¿ì½Ý·½Ê½ÊôÐÔÖеÄÆðʼλÖà y.WorkingDirectory = App.Path y.Save End SubPublic Sub CreateShortCutOnStartMenu(ByVal Name As String, ByVal Description As String) Dim x As New IWshRuntimeLibrary.IWshShell_Class Dim z As IWshRuntimeLibrary.IWshShortcut_Class Set z = x.CreateShortcut(x.SpecialFolders.Item("AllUsersStartMenu") & "\³ÌÐò\" & Name & ".lnk")'¿ì½Ý·½Ê½ÊôÐÔÖеÄÄ¿±ê z.TargetPath = App.Path & "\ÏîÄ¿¹ÜÀíϵͳ.exe" '¿ì½Ý·½Ê½ÊôÐÔÖеı¸×¢ z.Description = Description '¿ì½Ý·½Ê½ÊôÐÔÖеÄÆðʼλÖà z.WorkingDirectory = App.Path z.Save End Sub Public Sub main() Call CreateShortCutOnDeskTop("ÏîÄ¿¹ÜÀíϵͳ", "") Call CreateShortCutOnStartMenu("ÏîÄ¿¹ÜÀíϵͳ", "") End Sub
.url文件是文本格式,可以用VB代码:Name ... As ...把它改成.txt文件 当然也可以用文本方式做一个.url文件,如:把下面内容保存为.url文件试试[DEFAULT] BASEURL=http://office.9zp.com [InternetShortcut] URL=http://office.9zp.com IconIndex=0 IconFile=D:\WINDOWS\regedit.exe
Public Sub CreateShortCutOnDeskTop(ByVal Name As String, ByVal Description As String, TargetPath As String, WorkingDirectory As String)
Dim X As New IWshRuntimeLibrary.IWshShell_Class
Dim Y As IWshRuntimeLibrary.IWshShortcut_Class
'Attribute VB_Name = "ShortCut"
Set Y = X.CreateShortcut(X.SpecialFolders.item("AllUsersDesktop") & "\" & Name & ".lnk")
Y.TargetPath = TargetPath
Y.Description = Description
Y.WorkingDirectory = WorkingDirectory
Y.Save
End Sub
1.如何获取某一已存在的快捷方式(*.lnk)的所有信息?
Dim x As New IWshRuntimeLibrary.IWshShell_Class
Dim y As IWshRuntimeLibrary.IWshShortcut_Class
Set y = x.CreateShortcut("..\..\XXX.lnk")
Dim s As String
s = "Arguments: " & y.Arguments & vbCrLf _
& "Description: " & y.Description & vbCrLf _
& "FullName: " & y.FullName & vbCrLf _
& "Hotkey: " & y.Hotkey & vbCrLf _
& "IconLocation: " & y.IconLocation & vbCrLf _
& "TargetPath: " & y.TargetPath & vbCrLf _
& "WindowStyle: " & y.WindowStyle & vbCrLf _
& "WorkingDirectory: " & y.WorkingDirectory
MsgBox s
2.如何在 Windows 任务栏中创建快捷方式?
Dim x As New IWshRuntimeLibrary.IWshShell_Class
Dim y As IWshRuntimeLibrary.IWshShortcut_Class
If VBA.Len(VBA.Trim(VBA.Dir(x.SpecialFolders.Item("AppData") & "\Microsoft\Internet Explorer\Quick Launch\"))) > 0 Then
Set y = x.CreateShortcut(x.SpecialFolders.Item("AppData") & "\Microsoft\Internet Explorer\Quick Launch\WinRAR.lnk")
y.TargetPath = "..\..\XXX.exe"
y.Save
End If
'下面是几种 Windows 特殊路径:
AllUsersDesktop
AllUsersStartMenu
AllUsersPrograms
AllUsersStartup
AppData
Desktop
Favorites
Fonts
MyDocuments
NetHood
PrintHood
Programs
Recent
SendTo
StartMenu
Startup
Templates 综上 CreateShortcut 是用来创建一个 WshShortcut 的对象, 只要不调用其 Save 方法,就不会真正改变快捷方式的属性。
Sub CreateShortCuts()
Dim WSH_Shell As WshShell
Dim SCut As WshShortcut
Set WSH_Shell = New WshShell
Set SCut = WSH_Shell.CreateShortcut(TOUCHPATH & "\touch.lnk")
With SCut
.TargetPath = TOUCHPATH & "\touch.exe"
.WorkingDirectory = TOUCHPATH
.Save
End With
Set WSH_Shell = Nothing
Set SCut = Nothing
Dim FileNumber As Integer
FileNumber = FreeFile
'pif快捷方式的第430字节为8,全屏幕运行
Open TOUCHPATH & "\touch.pif" For Binary As #FileNumber
Put #FileNumber, 430, 8
Close #FileNumber
End Sub
Option ExplicitPublic Sub CreateShortCutOnDeskTop(ByVal Name As String, ByVal Description As String)Dim x As New IWshRuntimeLibrary.IWshShell_Class
Dim y As IWshRuntimeLibrary.IWshShortcut_Class
Set y = x.CreateShortcut(x.SpecialFolders.Item("AllUsersDesktop") & "\" & Name & ".lnk")
'¿ì½Ý·½Ê½ÊôÐÔÖеÄÄ¿±ê
y.TargetPath = App.Path & "\ÏîÄ¿¹ÜÀíϵͳ.exe"
'¿ì½Ý·½Ê½ÊôÐÔÖеı¸×¢
y.Description = Description
'¿ì½Ý·½Ê½ÊôÐÔÖеÄÆðʼλÖÃ
y.WorkingDirectory = App.Path
y.Save
End SubPublic Sub CreateShortCutOnStartMenu(ByVal Name As String, ByVal Description As String)
Dim x As New IWshRuntimeLibrary.IWshShell_Class
Dim z As IWshRuntimeLibrary.IWshShortcut_Class
Set z = x.CreateShortcut(x.SpecialFolders.Item("AllUsersStartMenu") & "\³ÌÐò\" & Name & ".lnk")'¿ì½Ý·½Ê½ÊôÐÔÖеÄÄ¿±ê
z.TargetPath = App.Path & "\ÏîÄ¿¹ÜÀíϵͳ.exe"
'¿ì½Ý·½Ê½ÊôÐÔÖеı¸×¢
z.Description = Description
'¿ì½Ý·½Ê½ÊôÐÔÖеÄÆðʼλÖÃ
z.WorkingDirectory = App.Path
z.Save
End Sub
Public Sub main()
Call CreateShortCutOnDeskTop("ÏîÄ¿¹ÜÀíϵͳ", "")
Call CreateShortCutOnStartMenu("ÏîÄ¿¹ÜÀíϵͳ", "")
End Sub
当然也可以用文本方式做一个.url文件,如:把下面内容保存为.url文件试试[DEFAULT]
BASEURL=http://office.9zp.com
[InternetShortcut]
URL=http://office.9zp.com
IconIndex=0
IconFile=D:\WINDOWS\regedit.exe