' ************************************************************************ ' ** ' ** 関数名 : PF_ShowDirSelectBox() ' ** +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ' ** ' ** 処理の概要: Shellを使用してディレクトリ選択ダイアログボックスを表示し、 ' ** 選択したディレクトリのフルパスを返す ' ** ' ** 注意!! 参照設定で ' ** 「Microsoft Shell Controls And Automation」 ' ** (SHELL32.DLL)を追加する必要があります。 ' ** ' ** 引数 : (なし) ' ** ' ** 戻り値 : ディレクトリ選択時・・・選択されたディレクトリへのフルパス ' ** それ以外 ・・・(空文字列"") ' ** ' ** 作成 : 2003/09/16 15:59 H.KIHARA ' ** ' ** ' ** BrowseForFolderメソッドの説明 ' ** 書式:object.BrowseForFolder Hwnd, Title, Options, [RootFolder] ' ** ' ** RootFolder ' ** enum ShellSpecialFolderConstants{ ' ** ssfDESKTOP = 0x0000, デスクトップ ' ** ssfPROGRAMS = 0x0002, [スタート]メニューのプログラム ' ** ssfCONTROLS = 0x0003, コントロールパネル ' ** ssfPRINTERS = 0x0004, プリンタ ' ** ssfPERSONAL = 0x0005, マイドキュメント ' ** ssfFAVORITES = 0x0006, お気に入り ' ** ssfSTARTUP = 0x0007, スタートアップ ' ** ssfRECENT = 0x0008, 最近使ったファイル ' ** ssfSENDTO = 0x0009, 「送る」 ' ** ssfBITBUCKET = 0x000a, ごみ箱 ' ** ssfSTARTMENU = 0x000b, スタートメニュー ' ** ssfDESKTOPDIRECTORY = 0x0010, マイコンピュータ ' ** ssfDRIVES = 0x0011, マイネットワーク ' ** ssfNETWORK = 0x0012, Netfood ' ** ssfNETHOOD = 0x0013, フォント ' ** ssfFONTS = 0x0014, テンプレート ' ** ssfTEMPLATES = 0x0015, ' ** } ShellSpecialFolderConstants; ' ** ' ** ' ************************************************************************ Public Function PF_ShowDirSelectBox(Optional sCaption As String = "ディレクトリを選択してください", Optional lRootFolder As Long = 17) As String Dim oFolder As Object Dim oShell As New Shell Dim sFolderName As String PF_ShowDirSelectBox = "" Set oFolder = oShell.BrowseForFolder(0, sCaption, 1, lRootFolder) If Not oFolder Is Nothing Then sFolderName = oFolder.Items.Item.Path PF_ShowDirSelectBox = sFolderName End If Set oShell = Nothing Set oFolder = Nothing End Function