'ＯＳが管理するフォルダのＩＤを取得する
Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
'ＩＤからフォルダの名前を取得する
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long
'メモリ解放
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)

'フォルダＩＤの値
'書籍などには &H0〜&H22 の値が掲載されていますが、次の２機種でテストした結果、値が返るのは[A]を付した１２個でした。
'富士通 FMV-5150DSP Windows95 4.00.950a IE 4.0 SP1
'NEC VersaPro NX VA30H Windows98 4.10.1998 IE 5.0

'次の機種では18の値が返りました(01/08/25)
'NEC Valuestar VG10J/3 WindowsMe 4.90.3000 IE 5.5

Public Const CSIDL_DESKTOP = &H0                    '「デスクトップ」フォルダ(C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ)[A]
Public Const CSIDL_INTERNET = &H1                   'インターネットフォルダ
Public Const CSIDL_PROGRAMS = &H2                   '「WINDOWS\ﾌﾟﾛｸﾞﾗﾑ」フォルダ(C:\WINDOWS\ｽﾀｰﾄ ﾒﾆｭｰ\ﾌﾟﾛｸﾞﾗﾑ)[A]
Public Const CSIDL_CONTROLS = &H3                   'コントロールパネルアプリケーション用アイコンフォルダ
Public Const CSIDL_PRINTERS = &H4                   'プリンタフォルダ
Public Const CSIDL_PERSONAL = &H5                   '「マイドキュメント」ディレクトリ(Meは[デスクトップ] 上の [マイドキュメント] フォルダ)(C:\My Documents)[A]
Public Const CSIDL_FAVORITES = &H6                  '「お気に入り」ディレクトリ(C:\WINDOWS\Favorites)[A]
Public Const CSIDL_STARTUP = &H7                    '「スタートアップ」フォルダ(C:\WINDOWS\ｽﾀｰﾄ ﾒﾆｭｰ\ﾌﾟﾛｸﾞﾗﾑ\ｽﾀｰﾄｱｯﾌﾟ)[A]
Public Const CSIDL_RECENT = &H8                     '「最近使ったファイル」フォルダ(C:\WINDOWS\Recent)[A]
Public Const CSIDL_SENDTO = &H9                     '「送る」ディレクトリ(C:\WINDOWS\SendTo)[A]
Public Const CSIDL_BITBUCKET = &HA                  'ごみ箱ディレクトリ
Public Const CSIDL_STARTMENU = &HB                  '「スタートメニュー」フォルダ(C:\WINDOWS\ｽﾀｰﾄ ﾒﾆｭｰ)[A]
Public Const CSIDL_DESKTOPDIRECTORY = &H10          '「デスクトップ」ディレクトリ(C:\WINDOWS\ﾃﾞｽｸﾄｯﾌﾟ)[A]
Public Const CSIDL_DRIVES = &H11                    'マイコンピュータフォルダ
Public Const CSIDL_NETWORK = &H12                   'NETWORKフォルダ
Public Const CSIDL_NETHOOD = &H13                   '「NetHood」フォルダ(C:\WINDOWS\NetHood)[A]
Public Const CSIDL_FONTS = &H14                     '「フォント」フォルダ(C:\WINDOWS\FONTS)[A]
Public Const CSIDL_TEMPLATES = &H15                 '「テンプレート」ディレクトリ(C:\WINDOWS\ShellNew)[A]
Public Const CSIDL_COMMON_STARTMENU = &H16          'スタートメニューに表示されるプログラムとフォルダを含むディレクトリ(全ユーザー用)
Public Const CSIDL_COMMON_PROGRAMS = &H17           'スタートメニューに表示されるプログラムグループを含むディレクトリ(全ユーザー用)
Public Const CSIDL_COMMON_STARTUP = &H18            'スタートアップフォルダに含まれるプログラムを含むディレクトリ(全ユーザー用)
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19   'デスクトップディレクトリ(全ユーザー用)
Public Const CSIDL_APPDATA = &H1A                   'アプリケーション定義データ用共通ディレクトリ &H1C と同様
Public Const CSIDL_PRINTHOOD = &H1B                 'プリンタリンクディレクトリ
Public Const CSIDL_ALTSTARTUP = &H1D                'スタートアッププログラムグループ内のスタートアップディレクトリ(特定ユーザー用)
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E         'スタートアッププログラムグループ内のスタートアップディレクトリ(全ユーザー用)
Public Const CSIDL_COMMON_FAVORITES = &H1F          'お気に入りディレクトリ(全ユーザー用)
Public Const CSIDL_INTERNET_CACHE = &H20            'インターネットキャッシュディレクトリ
Public Const CSIDL_COOKIES = &H21                   'インターネットクッキーディレクトリ
Public Const CSIDL_HISTORY = &H22                   'インターネット履歴ディレクトリ

Public Const MAX_PATH = 260

Public Function Y_GetSpecialFolder(hWnd As Long, FolderID As Long) As String
'***********************************************************
'機能 : 特別なフォルダを取得する
'引数 : hWnd= ウインドウハンドル　FolderID =フォルダＩＤ
'戻り値: フォルダのフルパス
'***********************************************************

    Dim longret As Long
    Dim pidlFolder As Long
    Dim strbuf As String

    longret = SHGetSpecialFolderLocation(hWnd, FolderID, pidlFolder)
    If longret >= 0 Then
        strbuf = Space$(MAX_PATH)
        longret = SHGetPathFromIDList(pidlFolder, strbuf)
        strbuf = BufEdit(strbuf)
        CoTaskMemFree pidlFolder
        Y_GetSpecialFolder = strbuf
    End If

End Function

Public Function BufEdit(Buf As String) As String
'***********************************************************
'機能 : 引数 Bufの文字列中の Nullコードを検索し、Nullコードを
' 除いた文字列を返す
'引数 : Buf = Nullコードを含む文字列
'戻り値: Nullコードを除いた文字列
'***********************************************************

    Dim i As Long

    i = InStr(Buf, vbNullChar)
    If i <> 0 Then
        BufEdit = Left$(Buf, i - 1)
    Else
        BufEdit = Buf
    End If

End Function