#057
AccessやWord、Excelなどのファイルを保存する際のデフォルトのフォルダである My Documentsフォルダのパスを取得するには、"SHELL32.DLL"にあるWindowsAPIの「SHGetSpecialFolderLocation」関数および「SHGetPathFromIDList」関数を使用します。
まず標準モジュールに次のコードを記述します。"Declare"の前に"Private"を付けることによってフォームのモジュールにも記述できます。
'特殊フォルダのIDを取得するAPI関数
Declare Function SHGetSpecialFolderLocation Lib "SHELL32.DLL" _
(ByVal hWndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
'特殊フォルダのIDからフォルダのパスを取得するAPI関数
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "SHELL32.DLL" _
(ByVal hWndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
'特殊フォルダのIDからフォルダのパスを取得するAPI関数
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
サンプルプロシージャ：
Function GetMyDocPath() As String
Const CSIDL_PERSONAL = &H5 'My Documents フォルダの定数
Const MAX_PATH = 260 'フォルダ名の長さの最大値
Dim strBuffer As String * MAX_PATH 'フォルダ名を受け取るバッファ
Dim lngSpFolderLocation As Long 'フォルダのID
Dim lngRet As Long
'API関数を呼び出して My Doucutents フォルダのIDを取得
lngRet = SHGetSpecialFolderLocation(Application.hWndAccessApp, _
CSIDL_PERSONAL, lngSpFolderLocation)
If lngSpFolderLocation <> 0 Then
'特殊フォルダのIDが取得できたら、API関数を呼び出して
'フォルダIDに対応したフォルダのパスを取り出します
lngRet = SHGetPathFromIDList(lngSpFolderLocation, strBuffer)
'返り値の後続の Null を取り除いて返します
'("C:\My Documents" などが返る.....必要なら最後に￥を付けます)
GetMyDocPath = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Else
'取得できなければ長さゼロの文字列を返します
GetMyDocPath = ""
End If
End Function
Const CSIDL_PERSONAL = &H5 'My Documents フォルダの定数
Const MAX_PATH = 260 'フォルダ名の長さの最大値
Dim strBuffer As String * MAX_PATH 'フォルダ名を受け取るバッファ
Dim lngSpFolderLocation As Long 'フォルダのID
Dim lngRet As Long
'API関数を呼び出して My Doucutents フォルダのIDを取得
lngRet = SHGetSpecialFolderLocation(Application.hWndAccessApp, _
CSIDL_PERSONAL, lngSpFolderLocation)
If lngSpFolderLocation <> 0 Then
'特殊フォルダのIDが取得できたら、API関数を呼び出して
'フォルダIDに対応したフォルダのパスを取り出します
lngRet = SHGetPathFromIDList(lngSpFolderLocation, strBuffer)
'返り値の後続の Null を取り除いて返します
'("C:\My Documents" などが返る.....必要なら最後に￥を付けます)
GetMyDocPath = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Else
'取得できなければ長さゼロの文字列を返します
GetMyDocPath = ""
End If
End Function
ここでは My Documents フォルダに特化したサンプルコードとしましたが、「Const CSIDL_PERSONAL = &H5」の部分を次のような定数定義に変えることによって、その他の特殊なフォルダのパスを取得することもできます。もちろんその場合には上記のコードのFunctionプロシージャ名を変えた方がよいでしょう。また、これを定数ではなくFunctionプロシージャの引数とすることによって、さまざまな特殊フォルダのパスを返す関数に作り上げることもできます。
※その他の特殊フォルダIDの定数(一例)
Const CSIDL_PROGRAMS = &H2 'スタート メニュー\プログラム
Const CSIDL_FAVORITES = &H6 'お気に入り
Const CSIDL_STARTUP = &H7 'スタート メニュー\プログラム\スタートアップ
Const CSIDL_RECENT = &H8 '最近使ったファイル(Recent)
Const CSIDL_SENDTO = &H9 '送る(SendTo)
Const CSIDL_STARTMENU = &HB 'スタート メニュー
