広告
広告
フォルダ選択ダイアログの表示。ファイルの出力先指定等にどうぞ。
第一引数 | |
---|---|
第四引数 | ダイアログタイトル |
第六引数 | カレントウィンドウハンドル |
戻り値 | 第一引数(フォルダ名フルパス) |
Option Compare Database Option Explicit Global Const CSIDL_DRIVES = 17 Type TBrInfo lngOwner As Long lngRoot As Long strDispName As String strTitle As String lngFlag As Long lngFn As Long lngParam As Long lngImage As Long End Type Declare Function SHBrowseForFolder Lib "Shell32" (lngL As TBrInfo) As Long Declare Function SHGetPathFromIDList Lib "Shell32" _ Alias "SHGetPathFromIDListA" _ (ByVal lngP As Long, ByVal strPath As String) As Long Public Function strZToStr(strX As String) As String strZToStr = Left$(strX, InStr(strX, vbNullChar) - 1) End Function Public Function BrFolder(strSeFolder As String, _ Optional varRoot As Variant, _ Optional varOptions As Variant, _ Optional varTitle As Variant, _ Optional varDisplayName As Variant, _ Optional varOwner As Variant) As Long Dim xxx As TBrInfo If Not IsMissing(varOwner) Then xxx.lngOwner = varOwner xxx.strDispName = String$(1024, 0) If IsMissing(varRoot) Then xxx.lngRoot = 0 Else xxx.lngRoot = varRoot End If If Not IsMissing(varTitle) Then xxx.strTitle = varTitle If Not IsMissing(varOptions) Then xxx.lngFlag = varOptions Dim lngP As Long, strPath As String lngP = SHBrowseForFolder(xxx) If Not IsMissing(varDisplayName) Then varDisplayName = strZToStr(xxx.strDispName) strPath = String$(5120, 0) SHGetPathFromIDList lngP, strPath strSeFolder = strZToStr(strPath) BrFolder = lngP End Function '++++++ Use example +++++++++++ ' Dim strTitl As String, strDest As String, lngRet As Long ' sTtl = "フォルダを選択してください。" ' Do ' lRet = BrFolder(strDest, , , strTitl, , Me.Hwnd) ' If lngRet = False Then ' Exit Do ' ElseIf sDest = "" Then ' If MsgBox("クリックでフォルダ選択してください。" & vbnewline _ & "選択を中止する場合はキャンセルをクリックしてください。" _ , 64 + vbOKCancel) <> vbOK Then ' lngRet = False ' Exit Do ' End If ' End If ' Loop Until lngRet And strDest > ""
広告