Con esta funcion van a poder sacar la mayoria de los directorios especiales de win,


Todo esto en un bas

Código:

Option Explicit


Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long



Private Type sh*tEMID
 cb As Long
 abID As Byte
End Type
Private Type ITEMIDLIST
 mkid As sh*tEMID
End Type


'CONSTANTE DEL TAMAÑO MÁXIMO DE NOMBRES DE DIRECTORIO
Private Const MAX_PATH = 260



'ENUMERACIÓN DE DIRECTORIOS DEL SISTEMA
Public Enum Directorios_Especiales
 ESCRITORIO = 0
 DESCONOCIDO1 = 1
 INICIO_PROGRAMA_USUARIO = 2
 PANEL_DE_CONTROL = 3
 IMPRESORAS = 4
 MIS_DOCUMENTOS_USUARIO = 5
 FAVORITOS_USUARIO = 6
 INICIO_INICIO_USUARIO = 7
 DOCUMENTOS_RECIENTES_USUARIO = 8
 ENVIAR_A_USUARIO = 9
 DESCONOCIDO2 = 10
 MENÚ_DE_INICIO = 11
 DESCONOCIDO3 = 12
 MI_MÚSICA = 13
 DESCONOCIDO5 = 14
 PAPELERA_DE_RECICLAJE = 15
 ESCRITORIO_USUARIO = 16
 MI_COMPUTADORA = 17
 ENTORNO_DE_RED = 18
 ENTORNO_DE_RED_USUARIO = 19
 TIPO_DE_LETRA = 20
 PLANTILLAS = 21
 INICIO_TODOS_NT = 22
 INICIO_PROGRAMAS_TODOS_NT = 23
 INICIO_INICIO_TODOS_NT = 24
 ESCRITORIO_TODOS_NT = 25
 DATOS_DE_APLICACIÓN_USUARIO = 26
 ENTORNO_DE_IMPRESORAS = 27
 DATOS_DE_APLICACIÓN_LOCALES = 28
 INICIO_NO_LOCALIZADOS = 29
 INICIO_NO_LOCALIZADOS_NT = 30
 FAVORITOS_TODOS_NT = 31
 TEMPORAL_DE_INTERNET = 32
 GALLETAS_INTERNET = 33
 HISTÓRICO_INTERNET = 34
 DATOS_DE_APLICACIÓN_TODOS_NT = 35
 WINDOWS = 36
 SISTEMA_DE_WINDOWS = 37
 ARCHIVOS_DE_PROGRAMA = 38
 MIS_IMÁGENES = 39
 PERFILES = 40
 SISTEMA_DE_WINDOWS2 = 41
 DESCONOCIDO7 = 42
 ARCHIVOS_COMUNES = 43
End Enum


Public Function GetSpecialfolder(CSIDL As Directorios_Especiales, Optional bCD As Boolean = True) As String
 Dim r As Long
 Dim IDL As ITEMIDLIST
 Dim Path$


 r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
 If r <> 0 Then GetSpecialfolder = "": Exit Function
 
 Path$ = Space$(512)
 
 r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
 
 Path = Left$(Path, InStr(Path, Chr$(0)) - 1)
 
 If bCD = True Then Path = Path & "\"
 GetSpecialfolder = Path


 
End Function

y asi lo mandas llamar

Código:

Private Sub Command1_Click()
MsgBox GetSpecialfolder(ARCHIVOS_DE_PROGRAMA)
End Sub