Office中国论坛/Access中国论坛

标题: [原创]获取系统的特定目录地址：我的文档、桌面。。。 [打印本页]

作者: secowu 时间: 2005-8-17 02:02
标题: [原创]获取系统的特定目录地址：我的文档、桌面。。。
'=====================================

'下面的模块是获取“我的文档”等的路径的，

'需要请自己改最后的函数集合就行了，

'还有。。。您看着吧，绝对好用

'By 狠狠活 2005-08-16

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Option Compare Database

Option Explicit

'程序有点长.所有的定义全在模块中..

'如果要显示我的文档的路径只要这么使用

'me.caption= GetSysDirPath(CSIDL_PERSONAL)

'SHGetSpecialFolderLocation获得某一个特殊的目录的位置,如果函数调用成功返回NOERROR

'或者一个OLE错误

Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _

(ByVal hwndOwner As Long, _

ByVal nFolder As SHSpecialFolderIDs, _

pidl As Long) As Long

'SHGetPathFromIDList函数将一个Item转换为文件路径

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _

(ByVal pidl As Long, _

ByVal pszPath As String) As Long

'SHGetFileInfoPidl函数获得某个文件对象的信息。

Declare Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _

(ByVal pidl As Long, _

ByVal dwFileAttributes As Long, _

psfib As SHFILEINFOBYTE, _

ByVal cbFileInfo As Long, _

ByVal uFlags As SHGFI_flags) As Long

Public Const MAX_PATH = 260

Public Const NOERROR = 0

Public Enum SHSpecialFolderIDs '列出所有Windows下特殊文件夹的ID

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

CSIDL_NETHOOD = &H13    '网上邻居

CSIDL_FONTS = &H14

CSIDL_TEMPLATES = &H15

CSIDL_COMMON_STARTMENU = &H16

CSIDL_COMMON_PROGRAMS = &H17

CSIDL_COMMON_STARTUP = &H18

CSIDL_COMMON_DESKTOPDIRECTORY = &H19

CSIDL_APPDATA = &H1A

CSIDL_PRINTHOOD = &H1B

CSIDL_ALTSTARTUP = &H1D

CSIDL_COMMON_ALTSTARTUP = &H1E

CSIDL_COMMON_FAVORITES = &H1F

CSIDL_INTERNET_CACHE = &H20

CSIDL_COOKIES = &H21

CSIDL_HISTORY = &H22         '历史文件夹

End Enum

Enum SHGFI_flags

SHGFI_LARGEICON = &H0

SHGFI_SMALLICON = &H1

SHGFI_OPENICON = &H2

SHGFI_SHELLICONSIZE = &H4

SHGFI_PIDL = &H8

SHGFI_USEFILEATTRIBUTES = &H10

SHGFI_ICON = &H100

SHGFI_DISPLAYNAME = &H200

SHGFI_TYPENAME = &H400

SHGFI_ATTRIBUTES = &H800

SHGFI_ICONLOCATION = &H1000

SHGFI_EXETYPE = &H2000

SHGFI_SYSICONINDEX = &H4000

SHGFI_LINKOVERLAY = &H8000

SHGFI_SELECTED = &H10000

End Enum

Public Type SHFILEINFOBYTE

hIcon As Long

iIcon As Long

dwAttributes As Long

szDisplayName(1 To MAX_PATH) As Byte

szTypeName(1 To 80) As Byte

End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _

(ByVal pszPath As String, _

ByVal dwFileAttributes As Long, _

psfi As SHFILEINFO, _

ByVal cbFileInfo As Long, _

ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFO

hIcon As Long

iIcon As Long

dwAttributes As Long

szDisplayName As String * MAX_PATH

szTypeName As String * 80

End Type

'根据一个特定文件夹对象的ID获得它的目录pidl

Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long

Dim pidl As Long

If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then

GetPIDLFromFolderID = pidl

作者: chaojianan 时间: 2009-10-24 15:21
收藏了。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)