読者です 読者をやめる 読者になる 読者になる

Logic Delight

明日のワシは忘れてしまうから、コードにはコメントを書くのです。

フォルダ選択ダイアログ

使用頻度が高そうな関数を、ま、どこにでもありそうですが書いてみました。

パラメタ用の列挙型

用意しておくと、呼び出し側から指定ができて便利かも、と。

'シェル特殊フォルダ定数列挙
Public Enum ShellSpecialFolderConstants
    ssfALTSTARTUP = &H1D
    ssfAPPDATA = &H1A
    ssfBITBUCKET = &HA
    ssfCOMMONALTSTARTUP = &H1E
    ssfCOMMONAPPDATA = &H23
    ssfCOMMONDESKTOPDIR = &H19
    ssfCOMMONFAVORITES = &H1F
    ssfCOMMONPROGRAMS = &H17
    ssfCOMMONSTARTMENU = &H16
    ssfCOMMONSTARTUP = &H18
    ssfCONTROLS = &H3
    ssfCOOKIES = &H21
    ssfDESKTOP = &H0
    ssfDESKTOPDIRECTORY = &H10
    ssfDRIVES = &H11
    ssfFAVORITES = &H6
    ssfFONTS = &H14
    ssfHISTORY = &H22
    ssfINTERNETCACHE = &H20
    ssfLOCALAPPDATA = &H1C
    ssfMYPICTURES = &H27
    ssfNETHOOD = &H13
    ssfNETWORK = &H12
    ssfPERSONAL = &H5
    ssfPRINTERS = &H4
    ssfPRINTHOOD = &H1B
    ssfPROFILE = &H28
    ssfPROGRAMFILES = &H26
    ssfPROGRAMFILESx86 = &H30
    ssfPROGRAMS = &H2
    ssfRECENT = &H8
    ssfSENDTO = &H9
    ssfSTARTMENU = &HB
    ssfSTARTUP = &H7
    ssfSYSTEM = &H25
    ssfSYSTEMx86 = &H29
    ssfTEMPLATES = &H15
    ssfWINDOWS = &H24
End Enum

それぞれの解説は、う〜ん。翻訳が面倒なので、MSDNサイトをご参考に、ってことで。
ShellSpecialFolderConstants Enumerated Type ()

関数本体

デフォルト引数で、初期選択フォルダをしていできます。上記の ShellSpecialFolderConstants 列挙型か、パス文字列のどちらでも指定可能です。

options も引数にしてよかったのですが、一旦やってみたのはいいものの、あまり需要がないかな・・・なんて思って固定にしちゃいました。選択されたフォルダのフルパス(未選択時は空文字)が返ります。

Public Function SelectFolder(Optional defaultPath = ShellSpecialFolderConstants.ssfDESKTOP) As String
'BrowseForFolderオプション
    Const BIF_EDITBOX = &H10                 'ダイアログボックス内にアイテム名入力用のテキストボックスを追加する
    Const BIF_RETURNNONLYFSDIRS = &H1        'ディレクトリのみ選択可能
    
    Dim options, objShell, objFolder
    Dim selectPath As String
On Error GoTo ErrLbl
    
    options = BIF_RETURNNONLYFSDIRS + BIF_EDITBOX
    Set objShell = CreateObject("Shell.Application")
    selectPath = ""

    Set objFolder = objShell.BrowseForFolder(0, "フォルダを選択してください。", options, defaultPath)
    
    If Not objFolder Is Nothing Then
        selectPath = objFolder.Self.path
    End If
        
    Set objFolder = Nothing
    Set objShell = Nothing
    
    SelectFolder = selectPath
    Exit Function
ErrLbl:
    SelectFolder = ""
End Function

options に指定できる値は、こちらのサイトで解説されている BROWSEINFO構造体の ulFlags を参考にできるかな、と。
BROWSEINFO