请问如何用VB程序在运行时在桌面上生成一个快捷方式？

Question

如何用VB建立快捷方式 
下面的代码向你演示在VB中如何创建一个快捷方式。Private Declare Function fCreateShellLink Lib "STKIT432.DLL" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArgs As String) As Long 
Sub Command1_Click()Dim lReturn As Long注释：添加到桌面
lReturn = fCreateShellLink("..\..\Desktop", "Shortcut to Calculator", "c:\windows\calc.exe", "")
注释：添加到程序组
lReturn = fCreateShellLink("", "Shortcut to Calculator", "c:\windows\calc.exe", "")
注释：添加到启动组
lReturn = fCreateShellLink("\Startup", "Shortcut to Calculator", "c:\windows\calc.exe", "")End Sub 

Answer 1

如果你没有STKIT432.DLL这个文件，来信[email protected]要！

Answer 2

以下的代码可以在桌面上建立一个 Internet 快捷键。
Dim StrURLFile As String
Dim StrURLTarget As String
Dim FileNum As IntegerStrURLFile = "C:\Windows\Desktop\强强小屋.url"    '桌面目录和标题
StrURLTarget = "http://qqxw.yeah.net"   '地址
FileNum = FreeFile'Write the Internet Shortcut file
Open StrURLFile For Output As FileNum
Print #FileNum, "[InternetShortcut]"
Print #FileNum, "URL=" & StrURLTarget
Close FileNum

Answer 3

''创建程序组： 
Sub CreateProgManGroup(DDELabel As Label, groupname As String, GroupPath As String) 
Screen.MousePointer = 11 
On Error Resume Next 
DDELabel.LinkTopic = "ProgMan|Progman" 
DDELabel.LinkMode = 2 
For i% = 1 To 10 '' Loop to ensure that there is enough time to 
Z% = DoEvents() '' process DDE Execute. This is redundant but needed 
Next '' for debug windows. 
DDELabel.LinkTimeout = 100 
DDELabel.LinkExecute "[CreateGroup(" + groupname$ + Chr$(44) + GroupPath$ + ")]" 
DDELabel.LinkTimeout = 50 
DDELabel.LinkMode = 0 
Screen.MousePointer = 0 
End Sub 
 
''创建快捷方式： 
Sub CreateProgManItem(DDELabel As Label, groupname As String, CmdLine As String, IconTitle As String) 
Dim i% 
Dim Z% 
Screen.MousePointer = 11 
On Error Resume Next 
DDELabel.LinkTopic = "ProgMan|Progman" 
DDELabel.LinkMode = 2 
For i% = 1 To 10 '' Loop to ensure that there is enough time to 
Z% = DoEvents() '' process DDE Execute. This is redundant but needed 
Next '' for debug windows. 
DDELabel.LinkTimeout = 100 
DDELabel.LinkExecute "[AddItem(" + """" + CmdLine + """" + Chr$(44) + IconTitle + Chr$(44) + ",,)]" 
DDELabel.LinkExecute "[ShowGroup(groupname, 1)]" 
DDELabel.LinkTimeout = 50 
DDELabel.LinkMode = 0 
Screen.MousePointer = 0 
End Sub 
 
''删除程序组： 
Sub DeleteProgManGroup(DDELabel As Label, groupname As String) 
Dim i% 
Dim Z% 
Screen.MousePointer = 11 
On Error Resume Next 
DDELabel.LinkTopic = "ProgMan|Progman" 
DDELabel.LinkMode = 2 
For i% = 1 To 10 '' Loop to ensure that there is enough time to 
Z% = DoEvents() '' process DDE Execute. This is redundant but needed 
Next '' for debug windows. 
DDELabel.LinkTimeout = 100 
DDELabel.LinkExecute "[DeleteGroup(" + groupname$ + ")]" 
DDELabel.LinkTimeout = 50 
DDELabel.LinkMode = 0 
Screen.MousePointer = 0 End Sub 
 
Sub RestoreProgMan() 
On Error GoTo RestoreProgManErr 
AppActivate "Program Manager" '' Activate Program Manager. 
SendKeys "%{ }{Enter}", True '' Send Restore keystrokes. 
RestoreProgManErr: 
Exit Sub 
End Sub 
 

Answer 4

关于"快捷方式"的几个问题 (引用 Windows Script Host Model) ....
http://www.csdn.net/expert/topic/214/214456.shtm