質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.49%

  • VB

    303questions

    VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。

vb6のフォルダ参照ダイアログの初期フォルダの指定方法

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 2,285

lob

score 1

現在フォルダ参照ダイアログを導入しているのですが、初期フォルダの指定方法がわかりません。

インターネットで調べたところ、方法はあるということは理解できたのですが、どうすればできるかがわかりません。

現在のソースを大きく修正しなくて済む方法はないかと調べていましたがわかりません。

アドバイス、または参考サイトなど教えていただきたいです。

どうかよろしくお願いいたします。

ソースですが、

'/* FolderBrowserDialog クラス モジュール */
Option Explicit


' SHBrowseForFolder 関数
Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" ( _
    ByRef lpBrowseInfo As TypeBrowseInfo _
) As Long


' SHGetPathFromIDList 関数
Private Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias "SHGetPathFromIDListA" ( _
    ByVal pidl    As Long,  _
    ByVal pszPath As String _
) As Long


' CoTaskMemFree 関数
Private Declare Sub CoTaskMemFree Lib "OLE32.DLL" (ByVal pv As Long)


' BrowseInfo 構造体
Private Type TypeBrowseInfo
    OwnerHandle As Long
    Root        As Long
    DisplayName As String
    Description As String
    Flags       As BifOptions
    lpfn        As Long
    lParam      As String
    iImage      As Long
End Type


' FolderBrowseDialog 設定用の列挙体
Private Enum BifOptions
    ReturnOnlyFileSystemDirectories = &H1     ' コントロールパネル・プリンタ・ブリーフケース内は選択不可
    HideNetworkResource             = &H2     ' ネットワーク内のリソースを非表示
    StatusText                      = &H4     ' テキスト文字列を表示 (設定は Callback 関数で行う)
    OnlyNetworkResource             = &H8     ' ネットワーク内のリソースのみ選択可能
    ShowEditBox                     = &H10    ' フォルダ名を編集する TextBox を表示
    Validate                        = &H20    ' 検証を実行する
    NewDialogStyle                  = &H40    ' 新しいフォルダの作成を表示 (Winodws 2000 以降から有効)
    BrowseForComputer               = &H1000  ' ネットワークコンピュータ内のリソースのみ選択可
    BrowseForPrinter                = &H2000  ' ネットワークプリンタのみ選択可
    BrowseIncludeFiles              = &H4000  ' フォルダ内のファイル名も表示 (Windows 98 以降)
End Enum


' プロパティ 変数
Private m_SelectedPath As String
Private BrowseInfo     As TypeBrowseInfo


' SelectedPath - Get
Public Property Get SelectedPath() As String
    SelectedPath = m_SelectedPath
End Property


' SelectedPath - Let
Public Property Let SelectedPath(ByVal value As String)
    m_SelectedPath = value
End Property


' Description - Get
Public Property Get Description() As String
    Description = BrowseInfo.Description
End Property


' Description - Let
Public Property Let Description(ByVal value As String)
    BrowseInfo.Description = value
End Property


' ShowNewFolderButton - Get
Public Property Get ShowNewFolderButton() As Boolean
    ShowNewFolderButton = ((BrowseInfo.Flags And NewDialogStyle) > 0)
End Property


' ShowNewFolderButton - Let
Public Property Let ShowNewFolderButton(ByVal value As Boolean)
    If value Then
        BrowseInfo.Flags = BrowseInfo.Flags Or NewDialogStyle
    Else
        BrowseInfo.Flags = BrowseInfo.Flags And Not NewDialogStyle
    End If
End Property


' コンストラクタ
Private Sub Class_Initialize()
    BrowseInfo.Flags = BrowseInfo.Flags Or NewDialogStyle
End Sub


'「フォルダの参照」ダイアログを表示する
Public Function ShowDialog(Optional ByVal hOwnerHandle As Long = 0&) As Boolean
    Dim lReturn As Long

    ' 親ハンドルを設定する
    BrowseInfo.OwnerHandle = hOwnerHandle

    '「フォルダの参照」ダイアログを呼び出す
    lReturn = SHBrowseForFolder(BrowseInfo)

    ' OK が押下された場合
    If lReturn <> 0 Then
        Dim stPath As String

        stPath = String$(65536, vbNullChar)

        Call SHGetPathFromIDList(lReturn, stPath)
        Call CoTaskMemFree(lReturn)

        Me.SelectedPath = Left$(stPath, InStr(stPath, vbNullChar) - 1)
        ShowDialog = True
    End If
End Function

呼び出し部が

    ' FolderBrowserDialog クラスの新しいインスタンスを生成する
    Dim cFolderBrowserDialog As FolderBrowserDialog
    Set cFolderBrowserDialog = New FolderBrowserDialog

    ' ダイアログの説明を設定する
    cFolderBrowserDialog.Description = "ここに説明を書いてください"

    ' [新しいフォルダ] ボタンを表示する (初期値 True)
    'cFolderBrowserDialog.ShowNewFolderButton = True

    ' ダイアログを表示し、戻り値が [OK] の場合は、選択したディレクトリを表示する
    If cFolderBrowserDialog.ShowDialog(Me.hWnd) Then
        Call MsgBox(cFolderBrowserDialog.SelectedPath)
    End If

    ' 不要になった時点で参照を解放する (Terminate イベントを早めに起こす)
    Set cFolderBrowserDialog = Nothing

となっています。

環境
WindowsXP Professional
VB6.0(SP6)

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

0

むかしむかし、あるしがないプログラマーが作成したものです。
参考になるでしょうか?

初期選択フォルダーの指定について処理を補足するとこんな感じです

SHBrowseForFolder()のパラメーターのBROWSEINFO.lpfn に callback function (ここではBrowseCallbackProc())を指定し、BROWSEINFO.lParam にBrowseCallbackProc()に渡すパラメーター(ここでは初期選択フォルダーのPATH)を設定します。
このBrowseCallbackProc()では、ファイル選択ダイアログの初期化時(BFFM_INITIALIZEDのとき)にCall SendMessageStr(lngHWnd, BFFM_SETSELECTIONA, 1&, StrConv(lngLpData, vbUnicode))としてlngLpData(初期選択フォルダーのPATH)を選択(BFFM_SETSELECTIONA)するWindowsメッセージを送信します。

' フォルダー選択ダイアログを表示
'  *** この内容を標準モジュールに作成してください ***
' strTitle    : ダイアログのタイトル
' lngOwnerHwnd: 親ウィンドウのウィンドウハンドル
' lngRoot     : ルートフォルダーの指定
' lngFlags    : 表示形態の指定
' strParam    : 初期状態選択フォルダー

Option Explicit

Private Const MAX_PATH            As Long = 260
Private Const BFFM_SETSTATUSTEXTA As Long = &H464&  ' ステータステキスト
Private Const BFFM_ENABLEOK       As Long = &H465&  ' OK ボタンの使用可否
Private Const BFFM_SETSELECTIONA  As Long = &H466&  ' アイテムを選択
Private Const BFFM_INITIALIZED    As Long = &H1&
Private Const BFFM_SELCHANGED     As Long = &H2&
Private Type RECT
        left As Long    'WindowのX座標
        top As Long     'WindowのY座標
        right As Long   'Windowの右端の座標
        bottom As Long  'Windowの底にあたる部分の座標
End Type
Private Type BROWSEINFO
    hWndOwner       As Long     'ダイアログの親ウィンドウのハンドル
    pidlRoot        As Long     'ディレクトリツリーのルート
    pszDisplayName  As String   'MAX_PATH
    lpszTitle       As String   'ダイアログの説明文
    ulFlags         As Long     'ENUM_FLAGS_FOLDER
    lpfn            As Long     'コールバック関数へのポインタ
    lParam          As String   'コールバック関数へのパラメータ
    iImage          As Long     'フォルダーアイコンのシステムイメージリスト
End Type
Public Enum ENUM_ROOT_FOLDER
    CSIDL_DESKTOP = &H0&                        ' デスクトップ
    CSIDL_INTERNET = &H1&                       ' インターネット
    CSIDL_PROGRAMS = &H2&                       ' Program Files
    CSIDL_CONTROLS = &H3&                       ' コントロールパネル
    CSIDL_PRINTERS = &H4&                       ' プリンタ
    CSIDL_PERSONAL = &H5&                       ' ドキュメントフォルダー
    CSIDL_FAVORITES = &H6&                      ' お気に入り
    CSIDL_STARTUP = &H7&                        ' スタートアップ
    CSIDL_RECENT = &H8&                         ' 最近使ったファイル
    CSIDL_SENDTO = &H9&                         ' 送る
    CSIDL_BITBUCKET = &HA&                      ' ごみ箱
    CSIDL_STARTMENU = &HB&                      ' スタートメニュー
    CSIDL_DESKTOPDIRECTORY = &H10&              ' デスクトップフォルダー
    CSIDL_DRIVES = &H11&                        ' マイコンピュータ
    CSIDL_NETWORK = &H12&                       ' ネットワーク(ネットワーク全体あり)
    CSIDL_NETHOOD = &H13&                       ' NETHOOD フォルダー
    CSIDL_FONTS = &H14&                         ' フォント
    CSIDL_TEMPLATES = &H15&                     ' テンプレート
    CSIDL_COMMON_STARTMENU = &H16&              '
    CSIDL_COMMON_PROGRAMS = &H17&               '
    CSIDL_COMMON_STARTUP = &H18&                '
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19&       '
    CSIDL_APPDATA = &H1A&                       '
    CSIDL_PRINTHOOD = &H1B&                     '
    CSIDL_ALTSTARTUP = &H1D&                    '
    CSIDL_COMMON_ALTSTARTUP = &H1E&             '
    CSIDL_COMMON_FAVORITES = &H1F&              '
    CSIDL_INTERNET_CACHE = &H20&                '
    CSIDL_COOKIES = &H21&                       '
    CSIDL_HISTORY = &H22&                       '
End Enum
Enum ENUM_FLAGS_FOLDER
    BIF_RETURNONLYFSDIRS = &H1&          ' フォルダのみ
    BIF_DONTGOBELOWDOMAIN = &H2&         ' ネットワークコンピューターを非表示
    BIF_STATUSTEXT = &H4&                ' ステータス表示
    BIF_RETURNFSANCESTORS = &H8&
    BIF_BROWSEFORCOMPUTER = &H1000&      ' ネットワークコンピューターのみ
    BIF_BROWSEFORPRINTER = &H2000&       ' プリンターのみ
    BIF_BROWSEINCLUDEFILES = &H4000&     ' 全て選択可能
End Enum

Private Declare Function SHBrowseForFolder Lib "shell32" (ByRef lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
        (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal wMsg As Long, _
         ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHFree Lib "shell32" Alias "#195" (ByVal pidl As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'
' フォルダー選択ダイアログを表示
'   strTitle     : ダイアログに表示する説明文。
'   lngOwnerHwnd : ダイアログのオーナーウィンドウ。
'   lngRoot      : CSIDL_xxx の定数
'   lngFlags     : BIF_xxx の定数
'   strParam     : デフォルトのフォルダーPATH
' 戻値  正常終了 - フォルダー名 / 異常終了 - ""
'
Public Function GetFolderName( _
    Optional ByRef strTitle As String = "フォルダーを選択してください", _
    Optional ByVal lngOwnerHwnd As Long = 0&, _
    Optional ByVal lngRoot As ENUM_ROOT_FOLDER = CSIDL_DESKTOP, _
    Optional ByVal lngFlags As ENUM_FLAGS_FOLDER = BIF_RETURNONLYFSDIRS, _
    Optional ByRef strParam As String = vbNullString) As String

    On Error GoTo Err_GetFolderName:

    Dim biParam     As BROWSEINFO
    Dim pidl        As Long
    Dim strPath     As String

    If lngOwnerHwnd = 0& Then
        lngOwnerHwnd = GetDesktopWindow()
    End If

    strPath = String$(MAX_PATH, vbNullChar)

    With biParam
        .hWndOwner = lngOwnerHwnd
        .pidlRoot = lngRoot
        .pszDisplayName = strPath
        .lpszTitle = strTitle & vbNullChar
        .ulFlags = lngFlags
        If Len(strParam) > 0& Then

            .lpfn = GetLong(AddressOf BrowseCallbackProc)
            .lParam = strParam & vbNullChar
        End If
    End With

    pidl = SHBrowseForFolder(biParam)

    If biParam.ulFlags And BIF_BROWSEFORCOMPUTER Then
        strPath = biParam.pszDisplayName
        strPath = left$(strPath, InStr(strPath, vbNullChar) - 1&)
    Else
        If pidl = 0& Then
            strPath = vbNullString
        Else
            If SHGetPathFromIDList(pidl, strPath) <> 0& Then
                strPath = left$(strPath, InStr(strPath, vbNullChar) - 1&)
            Else
                strPath = vbNullString
            End If
        End If
    End If

    Call SHFree(pidl)
    GetFolderName = strPath
Exit_GetFolderName:
    Exit Function

Err_GetFolderName:
    GetFolderName = vbNullString
    Resume Exit_GetFolderName:
End Function
'
'
'   SHBrowseForFolder API のコールバック関数。
'
Private Function BrowseCallbackProc(ByVal lngHWnd As Long, ByVal lngUMsg As Long, _
                            ByVal lngLParam As Long, ByVal lngLpData As String) As Long
    Select Case lngUMsg
        Case BFFM_INITIALIZED
            Call SendMessageStr(lngHWnd, BFFM_SETSELECTIONA, 1&, StrConv(lngLpData, vbUnicode))
        'Case BFFM_SELCHANGED
        ' ITEMが選択された時に処理を行いたい場合ここに書きます
    End Select
    BrowseCallbackProc = 0&
End Function

Private Function GetLong(varAddr As Variant) As Long
    GetLong = CLng(varAddr)
End Function

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/02/08 16:35

    早速のご回答ありがとうございます。
    やはり、コールバック関数を使いますよね。
    作り変えも視野に入れて調べてみます。

    キャンセル

  • 2017/02/08 16:36

    はい。callback関数を使用しないとできなかったです。と当時を思い出しました:-)

    キャンセル

  • 2017/02/08 16:38

    そうですか、情報ありがとうございます。
    修正だと差異を確認しながらになりそうなので、作り変えることにします。
    ご回答ありがとうございました。

    キャンセル

  • 2017/02/08 17:11

    作り変えたところ無事に目的どおりの動作になりました。
    現在のソースに追加する視点でのみ調べていたのでとてもよいアドバイスをいただきました。
    大変ありがとうございました。

    キャンセル

  • 2017/02/08 17:14

    解決して何よりです :-)

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.49%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VB

    303questions

    VB(ビジュアルベーシック)はマイクロソフトによってつくられたオブジェクト指向プログラミング言語のひとつで、同社のQuickBASICが拡張されたものです。VB6の進化版といわれています。