获取到的目录都是以系统当前设置为准。使用时只要把代码保存在一个模块中，调用时一个函数搞定。
Private Sub Command1_Click()
MsgBox GetWinPath(CSIDL_DESKTOP)
End Sub
'将下面的代码放入一个模块中
'*************************************************************************************************
'******************** 作者： 南宫飘雪 ******************************************
'*************************************************************************************************
Private ｄｅｃｌａｒｅ Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private ｄｅｃｌａｒｅ Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pIdl As Long, ByVal szPath As String) As Long
Private ｄｅｃｌａｒｅ Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private ｄｅｃｌａｒｅ Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private ｄｅｃｌａｒｅ Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const thePathMaxLen = 1024
Public Enum SHSpecialFolderIDs '注释：列出所有Windows下特殊文件夹的ID
CSIDL_DEFAULT = &HFF '默认，一般为空
CSIDL_DESKTOP = &H0 '“桌面”目录
CSIDL_INTERNET = &H1
CSIDL_PROGRAMS = &H2 '“程序”目录
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5 '“我的文档”目录
CSIDL_FAVORITES = &H6 '“收藏夹”目录
CSIDL_STARTUP = &H7 '“启动”目录
CSIDL_RECENT = &H8 '“最近文档”目录
CSIDL_SENDTO = &H9 '“发送到...”目录
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB '“开始”菜单目录
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12 'NETWORK目录
CSIDL_NETHOOD = &H13 'NETHOOD目录
CSIDL_FONTS = &H14 '“字体”目录
CSIDL_TEMPLATES = &H15 'TEMPLATES目录
CSIDL_COMMON_STARTMENU = &H16 '公用“开始”菜单目录
CSIDL_COMMON_PROGRAMS = &H17 '公用“程序”目录
CSIDL_COMMON_STARTUP = &H18 '公用“启动”目录
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_APPDATA = &H1A 'AppData目录
CSIDL_PRINTHOOD = &H1B '打印
CSIDL_ALTSTARTUP = &H1D
CSIDL_COMMON_ALTSTARTUP = &H1E
CSIDL_COMMON_FAVORITES = &H1F '公用收藏夹
CSIDL_INTERNET_CACHE = &H20 'Internet网页临时目录
CSIDL_COOKIES = &H21 'COOKIES目录
CSIDL_HISTORY = &H22 '历史记录
CSIDL_WINDOWS = &H8000& 'Windows目录
CSIDL_SYSTEM = &H8001& '系统目录，Win9x为SYSTEM,2K/XP为SYSTEM32的全路径
CSIDL_TEMP = &H8002& '临时目录全路径
End Enum
Public Function GetWinPath(ByVal PathLong As SHSpecialFolderIDs) As String
'注释：获取一个指定ID的Windows目录全路径
'输入：PathLong为目录ID号，详情参照SHSpecialFolderIDs
'注释：作者 南宫飘雪 Joforn@sohu.com
Dim tPath As String * thePathMaxLen
Dim pIdl As Long, pathL As Long
If PathLong < 255 Then
If SHGetSpecialFolderLocation(0&, PathLong, pIdl) Then Exit Function
If SHGetPathFromIDList(pIdl, tPath) Then
pathL = InStr(tPath, Chr(0))
If pathL Then
GetWinPath = Left(tPath, pathL - 1)
Else
GetWinPath = vbNullString
End If
End If
Else
ｓｅｌｅｃｔ Case PathLong
Case CSIDL_WINDOWS:
pathL = GetWindowsDirectory(tPath, thePathMaxLen)
Case CSIDL_SYSTEM:
pathL = GetSystemDirectory(tPath, thePathMaxLen)
Case CSIDL_TEMP:
pathL = GetTempPath(thePathMaxLen, tPath)
End ｓｅｌｅｃｔ
If pathL > 0 Then GetWinPath = Left(tPath, pathL)
End If
End Function