Eccoti accontentato/a
codice:
Option Explicit
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long _
    , ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll"  _
    Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Const CSIDL_DESKTOP = &H0     ' Desktop
Private Const CSIDL_PROGRAMS = &H2    ' Programmi
Private Const CSIDL_FAVORITES = &H6   ' Preferiti
Private Const CSIDL_STARTUP = &H7     ' Esecuzione automatica
Private Const CSIDL_RECENT = &H8      ' Recenti
Private Const CSIDL_SENDTO = &H9      ' SendTo
Private Const CSIDL_STARTMENU = &HB   ' StartMenu
Private Const CSIDL_FONTS = &H14      ' Fonts
Private Const CSIDL_TEMPLATES = &H15  ' Modelli
Private Const CSIDL_NETHOOD = &H13    ' Risorse di rete
Private Const CSIDL_PERSONAL = &H5    ' MyDocuments


'
Property Get Desktop() As String
' Restituisce la directory del Desktop

    Desktop = GetSpecialfolder(CSIDL_DESKTOP)
End Property

'
Private Function GetSpecialfolder(CSIDL As Long) As String
' Directory speciali

Dim sRetVal As String
Dim lRetVal As Long
Dim IDL As ITEMIDLIST

' ottiene la lista delle directory
lRetVal = SHGetSpecialFolderLocation(100, CSIDL, IDL)

If lRetVal = 0 Then

    ' Inizializza la stringa
    sRetVal = Space$(512)

    ' recupera il path dalla lista
    lRetVal = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sRetVal)
    If InStr(sRetVal, Chr$(0)) > 0 Then sRetVal = Left$(sRetVal, InStr(sRetVal, Chr$(0)) - 1)

    ' return
    GetSpecialfolder = sRetVal
End If
End Function
Ciao ciao
Simo