Create a desktop shortcut using code

[johnhutchison]

I have a little job where I need to use VBA code to copy some files from a CD to a computer, then create a desktop shortcut to one of them.

What works sometimes is to create a FileSystemObject, then use it to copy a shortcut file to the desktop folder.

With windows 95 and 98 the desktop folder is c:windowsdesktop

Is there any way of detecting where the desktop is, if it is somewhere other than this?

If the computer has got user profiles established, I would like to copy to the "All users" desktop. Can I find out where that is?

[HansV]

The location can be found in the registry.

The location of the user's desktop is the value of Desktop in HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVe rsionExplorerShell Folders.

The location of "All Users" desktop is the value of Common Desktop in HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentV ersionExplorerShell Folders.

[MarkD]

NOTE: Realized that this line from the GetSpecialFolder function:

lngIDL = SHGetSpecialFolderLocation(Application.hWndAccessA pp, CSIDL, IDL)

is Access-specific - the 1st argument, Application.hWndAccessApp, applies only to Access!! - If using this code in another application, then this line needs to be generalized as follows:

lngIDL = SHGetSpecialFolderLocation(GetHWndTop, CSIDL, IDL)

Code for GetHWndTop function, which returns the active application's top-level application window using some additional Windows API functions:

Declare Function apiGetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hwnd As Long) As Long

Function GetHWndTop() As Long

Dim lngHWnd As Long
Dim lngHWndTop As Long

' Get the handle to the currently active window:
lngHWnd = apiGetActiveWindow()

' Find the top window (has no parent window):
Do While lngHWnd <> 0
lngHWndTop = lngHWnd
lngHWnd = apiGetParent(lngHWnd)
Loop
GetHWndTop = lngHWndTop

End Function

Regret any confusion on this issue....

[MarkD]

<P ID="edit" class=small>(Edited by MarkD on 17-Mar-03 20:42. Clarification of code noted.)</P>If you're using VBA as indicated, you can use the following Windows API functions to get the Desktop folder path for either the currently logged in user, or for all users, on a WIN NT/2K/XP system. The GetDesktopPathUser function also works in WIN 98, but not sure about GetDesktopPathCommon - I use the former when creating desktop shortcuts. Recommend test on different systems to be safe. Sample code - paste into standard VBA module:

Option Compare Database
Option Explicit

Public Type ShortItemId
cb As Long
abID As Byte
End Type

Public Type ItemIDList
mkid As ShortItemId
End Type

Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19

' The file system directory that contains files and folders that appear _
on the desktop for all users. A typical path is _
Cocuments and SettingsAll UsersDesktop - Valid only for Windows NT systems.

Public Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long

Public Declare Function SHGetSpecialFolderLocation Lib _
"shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, _
pidl As ItemIDList) As Long

Function GetSpecialFolder(ByVal CSIDL As Long) As String
On Error GoTo Err_GetFolder

Dim lngIDL As Long
Dim strPath As String
Dim IDL As ItemIDList 'User-defined Type

Const NOERROR = 0
Const MAX_LENGTH = 260

' Fill the idl structure with the specified folder item:
' Note: this is Access-specific - see next post for clarification!!
lngIDL = SHGetSpecialFolderLocation(Application.hWndAccessA pp, CSIDL, IDL)

If lngIDL = NOERROR Then
' Get the path from the IDL list, and return folder with slash at end:
strPath = Space$(MAX_LENGTH)
lngIDL = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal strPath)
If lngIDL Then
GetSpecialFolder = Left$(strPath, InStr(strPath, Chr$(0)) - 1) & ""
End If
End If

Exit_GetFolder:
Exit Function
Err_GetFolder:
MsgBox Err.Description, vbCritical Or vbOKOnly
Resume Exit_GetFolder
End Function

Public Function GetDesktopPathUser() As String
GetDesktopPathUser = GetSpecialFolder(CSIDL_DESKTOPDIRECTORY)
End Function

Public Function GetDesktopPathCommon() As String
GetDesktopPathCommon = GetSpecialFolder(CSIDL_COMMON_DESKTOPDIRECTORY)
End Function

Example of use (WIN XP system):

? GetDesktopPathCommon
Cocuments and SettingsAll UsersDesktop

? GetDesktopPathUser
Cocuments and SettingsMARK DDesktop

For a list of other CSIDL constants to use for other special folders, see MSDN CSIDL List. If automating desktop shortcuts in VBA, & need something more sophisticated than copying shortcuts, check out the Windows Script Host CreateShortcut function - it can make life simpler if you need a "customized" shortcut for individual users.... I use CreateShortcut along with functions shown above for installing Access apps on individual desktops.

HTH

[johnhutchison]

Thanks Mark

I have just been trying to work out what to do about that line, becuse this specific case needs to work in Word ( and wasn't).

It now does here on my machine at least.