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