另外还要判断是否已经有了这个快捷方式 

没有的化就 

Dim appdisk$, Fname$ 
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" Alias "fCreateShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long 
Dim Winsys$, aa$ 
Public Function GetSysPath() As String 
  aa = Trim(Environ("ComSpec")) 
  GetSysPath = Mid(aa, 1, InStrRev(aa, "\")) 
End Function 

Private Sub Form_Load() 
  appdisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\") 
  Fname = appdisk & "工程1.exe" 
  Call OSfCreateShellLink("..\..\桌面", "工程1", appdisk & "工程1.exe", "") 
End Sub

回复于：2008-12-22 17:24:51提示 实时错误 '53' 

文件未找到 vb5stkit.dll 
 
 
对我有用[0] 丢个板砖[0] 引用 举报 管理 TOP 精华推荐：在北京的同志们来报道!周末爬香山 
 
ptzxzc
 
(MSDOS) 

等　级： 
 #3楼 得分：5回复于：2008-12-22 19:54:06'----------------------------------------------------- 
'              创建和删除快捷方式 
'----------------------------------------------------- 
'              洪恩在线  求知无限 
'----------------------------------------------------- 
'------名称-------------------作用-------------------- 
'      CmdAdd1            "创建test程序组快捷方式"按钮 
'      CmdAdd2            "创建桌面快捷方式"按钮 
'      CmdAdd3            "创建开始菜单快捷方式"按钮 
'      CmdAdd4            "创建Test程序组下的快捷方式"按钮 
'      CmdDel              "删除所有快捷方式"按钮 
'----------------------------------------------------- 
'要在VB中创建Windows的快捷方式，需要用到VB的一个动态链接库 
'Vb5stkit.dll。在该动态链接库中提供了三个函数 
'OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink 
'分别用于创建快捷方式程序组、创建快捷方式和删除快捷方式。 
'----------------------------------------------------- 
Private Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _ 
Alias "fCreateShellFolder" (ByVal lpstrDirName As String) As Long 
'lpstrDirName指定了程序组的名称 
'----------------------------------------------------- 
Private Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" _ 
Alias "fCreateShellLink" (ByVal lpstrFolderName As String, _ 
ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long 
'lpstrfoldername指定保存快捷方式的文件夹，默认为“c:\Windows\start menu\programs” 
'lpstrlinkname指定快捷方式的文件名 
'lpstrpathname指定快捷方式所指向的应用程序或文件 
'----------------------------------------------------- 
Private Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" _ 
Alias "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long 

Dim lresult As Long 
Private Sub CmdAdd1_Click() 
    Dim lresult As Long 
    '在程序菜单中添加一个名为Test的程序组 
    lresult = OSfCreateShellGroup("Test") 
End Sub 

Private Sub CmdDel_Click() 
Dim lresult As Long 
    '删除开始菜单上的快捷方式 
    lresult = OSfRemoveShellLink("..\..\start menu", "记事本") 
    '删除桌面上的快捷方式 
    lresult = OSfRemoveShellLink("..\..\desktop", "记事本") 
    '删除Test程序组下的快捷方式 
    lresult = OSfRemoveShellLink("Test", "记事本") 
    
End Sub 

Private Sub CmdAdd2_Click() 
    Dim lresult As Long 
    '在桌面创建记事本的快捷方式 
    lresult = OSfCreateShellLink("..\..\desktop", "记事本", "c:\Windows\notepad.exe", "") 
End Sub 

Private Sub CmdAdd4_Click() 
    '在程序菜单的Test程序组下创建记事本的快捷方式 
    lresult = OSfCreateShellLink("test", "记事本", "c:\Windows\notepad.exe", "") 
End Sub 

Private Sub CmdAdd3_Click() 
    '在开始菜单创建记事本的快捷方式 
    lresult = OSfCreateShellLink("..\..\start menu", "记事本", "c:\Windows\notepad.exe", "") 
End Sub 
 
 
对我有用[0] 丢个板砖[0] 引用 举报 管理 TOP 精华推荐：【分享】VB6里面多线程工程的正常退出问题 
 
ptzxzc
 
(MSDOS) 

等　级： 
 #4楼 得分：10回复于：2008-12-22 19:55:53VB code'事先在工程菜单中引用c:\windows\system32\WSHom.Ocx

'读取快捷方式属性
Private Sub Command1_Click()
    Dim WSH As WshShell
    Dim Urllink As WshShortcut
    Dim DeskPath As String
    Dim lnkName As String
  

    Set WSH = New WshShell
    DeskPath = WSH.SpecialFolders("Desktop")  '获得桌面路径
    
    lnkName = Dir(DeskPath & "\AA.lnk")
    Set Urllink = WSH.CreateShortcut(DeskPath & "\" & lnkName)
    With Urllink
        Print .TargetPath          '目标
        Print .Hotkey              '热键
        Print .WorkingDirectory    '工作目录
        Print .WindowStyle         '运行方式
        Print .Description         '备注
  End With
  Set Urllink = Nothing
  Set WSH = Nothing
  
End Sub

Private Sub Command2_Click()
'引用windows scripting host object model

   Dim WSH As WshShell
    Dim Urllink As WshShortcut
    Dim DeskPath As String
    Dim lnkName As String
  
    Set WSH = New WshShell
    DeskPath = WSH.SpecialFolders("Desktop")  '获得桌面路径
    
    '得到快捷方式
    lnkName = Dir(DeskPath & "\*.lnk")
    Debug.Print lnkName
    While Len(lnkName)
        Debug.Print lnkName
        lnkName = Dir
    Wend
    
    '可以用wsh_shell.expandenvironmentstrings("%windir%")获得windows路径
    Set Urllink = WSH.CreateShortcut(DeskPath & "\Test.lnk")
    With Urllink
        .TargetPath = "d:\test.txt"         '目标
        .IconLocation = WSH.ExpandEnvironmentStrings _
            ("%SystemRoot%\system32\SHELL32.dll,70")     '图标,可以是自己的ico
        .Hotkey = "ctrl+shift+F"            '快捷键
        .WorkingDirectory = "d:\"           '起始位置
        .WindowStyle = 1                    '运行方式
        .Description = "新疆鼎立科技"       '备注
        .Arguments = StrArg '参数
  End With
  Urllink.Save '保存快捷方式
  
'  '添加到桌面
'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

Private Sub Form_Load()

End Sub