ここでいう特殊フォルダとは、まぁ、下のソースを見れば分かるはず(多分)。 なお下の関数は Favorites(お気に入り)フォルダ のパスを取得するサンプルとなっている。必要に応じて拡張してください。
Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Const CSIDL_DESKTOP = &H0 'Desktopフォルダ Private Const CSIDL_PROGRAMS = &H2 'プログラムフォルダ Private Const CSIDL_CONTROLS = &H3 Private Const CSIDL_PRINTERS = &H4 Private Const CSIDL_PERSONAL = &H5 'My Documentsフォルダ Private Const CSIDL_FAVORITES = &H6 'favoriteフォルダ Private Const CSIDL_STARTUP = &H7 'スタートアップフォルダ Private Const CSIDL_RECENT = &H8 'Recent フォルダ Private Const CSIDL_SENDTO = &H9 'Send Toフォルダ Private Const CSIDL_BITBUCKET = &HA Private Const CSIDL_STARTMENU = &HB 'スタートメニューフォルダ Private Const CSIDL_DESKTOPDIRECTORY = &H10 'デスクトップフォルダ Private Const CSIDL_DRIVES = &H11 Private Const CSIDL_NETWORK = &H12 Private Const CSIDL_NETHOOD = &H13 Private Const CSIDL_FONTS = &H14 'fontsフォルダ Private Const CSIDL_TEMPLATES = &H15 'ShellNewフォルダ '------------------------------------------------------------------- ' 関数名 : GetSpecialFolder ' 機能 : 特殊フォルダを取得する ' 引数 : (in)hWnd … ウインドウハンドル ' 返り値 : 正常:特殊フォルダのパス エラー:空文字列 '------------------------------------------------------------------- Public Function GetSpecialFolder(ByVal hWnd As Long) As String Dim ret As Long Dim tmpPath As String * 256 Dim udtITEMIDLIST As ITEMIDLIST 'Favoritesフォルダを取得する ret = SHGetSpecialFolderLocation(hWnd, CSIDL_FAVORITES, udtITEMIDLIST) If ret = 0 Then ret = SHGetPathFromIDList(ByVal udtITEMIDLIST.mkid.cb, ByVal tmpPath) GetSpecialFolder = Left$(tmpPath, InStr(tmpPath, Chr$(0)) - 1) Else GetSpecialFolder = "" Exit Function End If '"\"をつけて返す GetSpecialFolder = GetSpecialFolder & "\" End Function |