Obtener la ubicación de las carpetas del sistema

Option Explicit On
' Definimos las constantes de las carpetas 
Const CSIDL_DESKTOP = &H0
Const CSIDL_PROGRAMS = &H2
Const CSIDL_CONTROLS = &H3
Const CSIDL_PRINTERS = &H4
Const CSIDL_PERSONAL = &H5
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTUP = &H7
Const CSIDL_RECENT = &H8
Const CSIDL_SENDTO = &H9
Const CSIDL_BITBUCKET = &HA
Const CSIDL_STARTMENU = &HB
Const CSIDL_DESKTOPDIRECTORY = &H10
Const CSIDL_DRIVES = &H11
Const CSIDL_NETWORK = &H12
Const CSIDL_NETHOOD = &H13
Const CSIDL_FONTS = &H14
Const CSIDL_TEMPLATES = &H15
Const MAX_PATH = 260
Private Type SHITEMID
    cb As Long 
    abID As Byte 
End Type 
Private Type ITEMIDLIST 
    mkid As SHITEMID 
End Type 
Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, _
    ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, _
    ByVal nFolder As Long, ByVal 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 Sub Form_Load()
    ' Activamos el grafico persistente en el formulario 
    Me.AutoRedraw = True
    ' Mostramos la información en el formulario 
    ' Algunas carpetas devolvera vacio en función del sistema en el que trabajeis 
    Me.Print("Carpeta Desktop..........: " + CarpetadelSistema(CSIDL_DESKTOP))
    Me.Print("Carpeta Programs.........: " + CarpetadelSistema(CSIDL_PROGRAMS))
    Me.Print("Carpeta Controls.........: " + CarpetadelSistema(CSIDL_CONTROLS))
    Me.Print("Carpeta Printers.........: " + CarpetadelSistema(CSIDL_PRINTERS))
    Me.Print("Carpeta Personal.........: " + CarpetadelSistema(CSIDL_PERSONAL))
    Me.Print("Carpeta Favorites........: " + CarpetadelSistema(CSIDL_FAVORITES))
    Me.Print("Carpeta Star UP..........: " + CarpetadelSistema(CSIDL_STARTUP))
    Me.Print("Carpeta Recent...........: " + CarpetadelSistema(CSIDL_RECENT))
    Me.Print("Carpeta Send To..........: " + CarpetadelSistema(CSIDL_SENDTO))
    Me.Print("Carpeta Bit Bucket.......: " + CarpetadelSistema(CSIDL_BITBUCKET))
    Me.Print("Carpeta Start Menu.......: " + CarpetadelSistema(CSIDL_STARTMENU))
    Me.Print("Carpeta Desktop Directory: " + CarpetadelSistema(CSIDL_DESKTOPDIRECTORY))
    Me.Print("Carpeta Drivers..........: " + CarpetadelSistema(CSIDL_DRIVES))
    Me.Print("Carpeta Network..........: " + CarpetadelSistema(CSIDL_NETWORK))
    Me.Print("Carpeta Net Hood.........: " + CarpetadelSistema(CSIDL_NETHOOD))
    Me.Print("Carpeta Fonts............: " + CarpetadelSistema(CSIDL_FONTS))
    Me.Print("Carpeta Templates........: " + CarpetadelSistema(CSIDL_TEMPLATES))
End Sub
Private Function CarpetadelSistema(ByVal CSIDL As Long) As String
    Dim Res As Long, Camino As String, IDL As ITEMIDLIST
    ' Obtenemos el controlador del sistema 
    Res = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If Res = 0 Then
        'Creamos el buffer 
        Camino = Space$(512)
        'Obtenermos el camino de IDList 
        Res = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Camino) 
        ' Eliminamos los caracteres Chr(0) 
        CarpetadelSistema = Left$(Camino, InStr(Camino, Chr$(0)) - 1)
        Exit Function
    End If
    CarpetadelSistema = ""
End Function