CreateShortcutDesk

Option Explicit
Dim IconCount As Long
Dim DesktopHandle As Long
Public Enum SHOWCMDFLAGS
SHOWNORMAL = 5
SHOWMAXIMIZE = 3
SHOWMINIMIZE = 7
End Enum
Public Function CreateShellLink&(LnkName$, ExeFile$, WorkDir$, ExeArgs$, _
Iconfile$, IconIdx&, ShowCmd As SHOWCMDFLAGS)
Dim LnkFile$ ' LinkName & extension
Dim myPath$ ' Application path
Dim cShellLink As ShellLinkA ' An explorer IShellLinkA(Win 95/Win98/WinNT) instance
Dim cPersistFile As IPersistFile ' An explorer IPersistFile instance
Dim hwnd&
Const lnk$ = ".lnk" ' Link extension
'---------------------------------------------------------------

If LnkName = "" Or ExeFile = "" Then
Exit Function ' Validate min. input requirements.
End If
myPath = App.path
If Right$(myPath, 1) <> "\" Then myPath = myPath & "\"
LnkFile = IIf(InStr(LnkName, "\"), LnkName & lnk, myPath & LnkName & lnk)
'-------------------------------------------------------------------

''# Search the Desktop Handle

' hwnd = FindWindow("progman", "program manager")

' hwnd = FindWindowEx(hwnd, 0, "shelldll_defview", vbNullString)

' DesktopHandle = FindWindowEx(hwnd, 0, "syslistview32", vbNullString)

' '# Count Icons

' IconCount = SendMessageByLong(DesktopHandle, LVM_GETITEMCOUNT, 0, 0)

'-------------------------------------------------------------------

CreateShellLink = False' Preset Return Unsuccess
On Error GoTo ErrHandler
Set cShellLink = New ShellLinkA ' Create new IShellLink interface
Set cPersistFile = cShellLink ' Implement cShellLink's IPersistFile interface
With cShellLink
.SetPath ExeFile ' set command line exe name & path to new ShortCut
If (WorkDir <> "") Then .SetWorkingDirectory WorkDir ' Set working directory in shortcut
If (ExeArgs <> "") Then .SetArguments ExeArgs ' Add arguments to command line
If (Iconfile <> "") Then .SetIconLocation Iconfile, IconIdx ' Set shortcut icon location & index
.SetShowCmd IIf(ShowCmd = 0, SHOWNORMAL, ShowCmd) ' Set shortcut's startup mode
End With
cShellLink.Resolve 0, SLR_UPDATE
cPersistFile.Save StrConv(LnkFile, vbUnicode), 0 ' Unicode conversion back... This must be done!
CreateShellLink = True ' Return Success
'---------------------------------------------------------------

ErrHandler:
'---------------------------------------------------------------

Set cPersistFile = Nothing ' Destroy Object
Set cShellLink = Nothing ' Destroy Object
'---------------------------------------------------------------

End Function

Than:
You need to make a reference to "Shelllnk.tlb" in your project.
You'll find it at VB-CD under "VB5\Tools\Unsupprt\Shelllnk\"
folder. It *must* be. Then you can create a shortcut anywhere on
your computer by using the following function
(for more information see sample code in the named folder):

To get the desktop folder:

HK = HKEY_CURRENT_USER
buff = "software\microsoft\windows\currentversion\explorer\shell folders"
ret = RegOpenKeyEx(HK, buff, 0, KEY_QUERY_VALUE, pl)

buff = String(127, 0): bf = 128
ret = RegQueryValueEx(pl, "Desktop", 0, REG_SZ, buff, bf)
buff = Left$(buff, bf - 1)
TMPDesk = buff & "\"

Now TMPDesk containts the right path to desktop folder.