获取系统常用文件夹的目录

opel-wong

将以下代码放在一个公共模块中：

1. Option Explicit
   
2. Private Const NOERROR = 0
   
3. Private Const CSIDL_Users_FAVORITES = &H6    '当前用户\收藏夹
   
4. Private Const CSIDL_Users_DESKTOPDIRECTORY = &H10    '当前用户\桌面
   
5. Private Const CSIDL_Users_STARTMENU = &HB    '当前用户\开始菜单
   
6. Private Const CSIDL_Users_STARTMENU_cx = &H2    '当前用户\开始-程序
   
7. Private Const CSIDL_Users_MyDocuments = &H5    '当前用户\我的文档
   
8. Private Const CSIDL_Users_STARTMENU_a = &H7    '当前用户\开始-程序-启动
   
9. Private Const CSIDL_Users_Recent = &H8    '当前用户\'Recent
   
10. Private Const CSIDL_Users_SendTo = &H9    '当前用户\SendTo
    
11. Private Const CSIDL_Users_MyMusic = &HD    '当前用户\My Documents\My Music\
    
12. Private Const CSIDL_Users_NetHood = &H13    '当前用户\NetHood
    
13. Private Const CSIDL_Users_Templates = &H15    '当前用户\Templates
    
14. Private Const CSIDL_Users_AppData = &H1A    '当前用户\Application Data\
    
15. Private Const CSIDL_Users_PrintHood = &H1B    '当前用户\PrintHood\
    
16. Private Const CSIDL_Users_Local_AppData = &H1C    '当前用户\Local Settings\Application Data\
    
17. Private Const CSIDL_Users_Temp = &H20    '当前用户\Local Settings\Temporary Internet Files\
    
18. Private Const CSIDL_Users_Cookies = &H21    '当前用户\Cookies\
    
19. Private Const CSIDL_Users_History = &H22    '当前用户\Local Settings\History\
    
20. Private Const CSIDL_Users_Pictures = &H27    '当前用户\My Documents\My Pictures\
    
21. Private Const CSIDL_Users = &H28    '当前用户\
    
22. Private Const CSIDL_Users_gl = &H30    '当前用户\「开始」菜单\程序\管理工具\
    
23. Private Const CSIDL_Users_CDBurning = &H3B    '当前用户\Local Settings\Application Data\Microsoft\CD Burning\
    
24. Private Const CSIDL_AllUsers_STARTMENU = &H16    'All Users\「开始」菜单\
    
25. Private Const CSIDL_AllUsers_STARTMENU_cx = &H17    'All Users\「开始」菜单\程序\
    
26. Private Const CSIDL_AllUsers_STARTMENU_j = &H18    'All Users\「开始」菜单\程序\启动\
    
27. Private Const CSIDL_AllUsers_DESKTOPDIRECTORY = &H19    'All Users\桌面
    
28. Private Const CSIDL_AllUsers_FAVORITES = &H1F    'All Users\Favorites\(收藏夹)
    
29. Private Const CSIDL_AllUsers_Templates = &H2D    'All Users\Templates\
    
30. Private Const CSIDL_AllUsers_Documents = &H2E    'All Users\Documents\
    
31. Private Const CSIDL_AllUsers_gl = &H2F    'All Users\「开始」菜单\程序\管理工具\
    
32. Private Const CSIDL_AllUsers_Music = &H35    'All Users\Documents\My Music\
    
33. Private Const CSIDL_AllUsers_Pictures = &H36    'All Users\Documents\My Pictures\
    
34. Private Const CSIDL_AllUsers_Videos = &H37    'All Users\Documents\My Videos\
    
35. Private Const CSIDL_AllUsers_AppData = &H23    'All Users\Application Data\
    
36. Private Const CSIDL_WinDows = &H24    '系统安装路径 C:\WINDOWS\
    
37. Private Const CSIDL_WinSystem = &H25    '系统文件夹 C:\WINDOWS\system32\
    
38. Private Const CSIDL_ProgramFiles = &H26    '应用程序安装文件夹 C:\Program Files\
    
39. Private Const CSIDL__ProgramFiles_CommonFiles = &H2B    'C:\Program Files\Common Files\
    
40. Private Const CSIDL_WIN_Resources = &H38    'C:\WINDOWS\Resources\
    
41. Private Const CSIDL_font = &H14    '字体文件夹C:\WINDOWS\Fonts\
    
42. ' 声明API函数
    
43. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    
44. Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
    
45. 
    
46. Public Function GetSpecialPath(CSIDL As Long) As String
    
47.     Dim s As Long, path As String, pidl As Long
    
48.     '根据指定的文件夹获得pidl
    
49.     s = SHGetSpecialFolderLocation(Application.Hwnd, CSIDL, pidl)
    
50.     If s = NOERROR Then    ' 根据s的返回值判断是否有错误发生，如果没有错误就获取文件夹路径
    
51.         path = Space$(512)
    
52.         s = SHGetPathFromIDList(ByVal pidl, ByVal path)
    
53.         GetSpecialPath = Left$(path, InStr(path, Chr$(0)) - 1) & ""
    
54.         Exit Function
    
55.     End If
    
56.     GetSpecialPath = ""
    
57. End Function

复制代码

' 调用函数GetSpecialPath(参数)
Sub 获取目录测试()
    MsgBox GetSpecialPath(&H15)
End Sub


只需要改变以上过程中蓝色字体的值，就可以很方便获取系统常用文件夹的目录了。


.

songcheer

学习了，多谢～～

opel-wong

songcheer 发表于 2014-11-13 14:46
学习了，多谢～～

多谢支持。

前进者

受教了，标记一下，以便学习备用！