Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Function GETFAVORITES() As String
Dim IDL As ITEMIDLIST
SHGetSpecialFolderLocation 100, CSIDL_FAVORITES, IDL
GETFAVORITES = String(512, Chr(0))
SHGetPathFromIDList ByVal IDL.mkid.cb, ByVal GETFAVORITES
GETFAVORITES = Split(GETFAVORITES, Chr(0))(0)
End Function
Private Sub Command1_Click()
MsgBox GETFAVORITES, vbOKCancel, "系统收藏夹的目录"
End Sub
当前系统收藏夹就是有以下几部分组成
C:\Documents and Settings\当前用户名\Favorites
Documents and Settings:固定的
Favorites:固定的
运行这段代码可以看到系统根目录
Dim ofso As New FileSystemObject
Dim oFolder As Folder
Set oFolder = ofso.GetSpecialFolder(0)
MsgBox oFolder.Drive
运行以下可以找到当前用户名
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function UserName() As String
Const UNLEN = 256 ' Max user name length.
Dim user_name As String
Dim name_len As Long
user_name = Space$(UNLEN + 1)
name_len = Len(user_name)
If GetUserName(user_name, name_len) = 0 Then
UserName = "<unknown>"
Else
UserName = Left$(user_name, name_len - 1)
End If
End Function