● 特殊フォルダのパスを取得する ●

ここでいう特殊フォルダとは、まぁ、下のソースを見れば分かるはず(多分)。

なお下の関数は 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

戻る