フォルダダイアログの初期位置について

解決

---

現在、コマンドボタンを押したときにフォルダ選択ダイアログBOXを表示しています。初期値を設定していないので、いつもC:\の位置になるのですが、
ファイル選択ダイアログのように、フォルダ選択ダイアログも初期位置の設定をできるのでしょうか？

APIを使っていると思うのですけど、APIはまだまだ初心者で全くわからないので、
設定方法などご教授お願いします。


現在はこのような感じで設定しております。
（ネットからサンプルをひろいました。）
'関数の宣言 フォルダ選択
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpbuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
'構造体定義
Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags  As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Private Const MAX_PATH = 260




    With tBrowseInfo
    .hWndOwner = Me.hWnd
    .lpszTitle = lstrcat(szTitle, "")
    .ulFlags = BIF_RETURNONLYFSDIRS ' + BIF_DONTGOBELOWDOMAIN
    End With
    
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        txtName.Text = sBuffer
    End If

編集 削除

---

コールバック関数を使う必要があります。

参考
http://homepage1.nifty.com/OkaLab/Program/VbTips01.html#03

編集 削除

---

ごめんなさい。
質問の内容を勘違いしていました。

でも、内容は参考にはなると思います。

編集 削除

---

ナトリさんありがとうございます。
乗せていただいたHPを見たのですが、何分、VBの初心者で、APIはまだ
まったくといっていいくらいわかりませんので、上級者の方でしたら
すぐにわかると思うんですけど、私には無理でした（；；）

コールバック関数を使用とかいてあったのですが、これも何か宣言とかを
しないといけないんでしょうか？

初歩的な質問ですみません。
お願いします。

編集 削除

---

'-------------------------------------------------------------
Public Declare Function SendMessage Lib...ny) As Long

Public Const WM_USER = &H400
Public Const BFFM_SETS...ER + 102)
Public Const BFFM_INITIALIZED = 1

Public Function BrowseCallbackProc(By...ng) As Long
'コールバック関数
      If uMsg = BFFM_INITIALIZED Then
            SendMessag...al lpData
      End If
End Function

Public Function FARPROC(pfn As Long) As Long
'AddressOf...す関数
      FARPROC = pfn
End Function
'-----------------------------------------------------------------------
標準モジュールに以上のことを書き、
# 途中、省略してあります。

実際使用するところに、
.lpfn = FARPROC(AddressOf BrowseCallbackProc)      'コールバック関数のアドレス
と記述すれば良いかと。

編集 削除

---

# 上の訂正
.lParam も必要ですね。

.lpfn = FARPROC(AddressOf BrowseCallbackProc)      'コールバック関数のアドレス
.lParam = CurDir & vbNullChar                              '初期フォルダのパス名

編集 削除

---

回答1412 さん
ありがとうございます。
HPと回答1412さんのご教授をよくよくみまして、
やってみたのですが、エラーばかりでて、コンパイルもとおりません・・・。

フォルダダイアログを表示するためだけのフォームを新規作成し、コマンドボタンを
１つだけつくり、ボタンを押したときの処理を作成したんですが、

何か参照設定など、フォームを作成する前段階での設定があるんでしょうか・・・？
それとも、プログラムがまちがってるんでしょうか・・・。（；−；）

編集 削除

---

下記、鷹さんのSub Test()なんか使えないのでしょうか？
違ってたらごめんなさい。

http://www2.moug.net/app/bbs/message.php?cat=exvba&id=20040324-000008

編集 削除

---

これでどうですか？

<フォーム>
コマンドボタンをひとつ貼り付ける

Option Explicit

Private Sub Command1_Click()

    MsgBox GetFolderDialog(Me.hwnd, CSIDL_DRIVES, "C:\Program Files", "フォルダ選択してください", BIF_SHOW)
End Sub

<標準モジュール>
Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type BROWSEINFO
    hwndOwner      As Long
    pidlRoot       As Long
    pszDisplayName As String
    lpszTitle      As String
    ulFlags        As Long
    lpfn           As Long
    lParam         As Long
    iImage         As Long
End Type

Public Const CSIDL_DESKTOP = &H0           '[デスクトップ]
Public Const CSIDL_INTER_EXP = &H1         '[InterNet Explorer]
Public Const CSIDL_PROGRAMS = &H2          '[プログラム]
Public Const CSIDL_CONTROLS = &H3          '[コントロールパネル]
Public Const CSIDL_PRINTERS = &H4          '[プリンタ]
Public Const CSIDL_PERSONAL = &H5          '[My Documents]
Public Const CSIDL_FAVORITES = &H6         '[お気に入り]
Public Const CSIDL_STARTUP = &H7           '[スタートアップ]
Public Const CSIDL_RECENT = &H8            '[Recent]
Public Const CSIDL_SENDTO = &H9            '[SendTo]
Public Const CSIDL_BITBUCKET = &HA         '[ごみ箱]
Public Const CSIDL_STARTMENU = &HB         '[スタートメニュー]
Public Const CSIDL_DESKTOPDIRECTORY = &H10 '[デスクトップ(フォルダ)]
Public Const CSIDL_DRIVES = &H11           '[マイコンピュータ]
Public Const CSIDL_NETWORK = &H12          '[ネットワークコンピュータ]
Public Const CSIDL_NETHOO = &H13           '[NetHood]
Public Const CSIDL_FONTS = &H14            '[Fonts]
Public Const CSIDL_TEMPLATES = &H15        '[ShellNew]

Public Const BIF_CLOSE = &H1                '特殊フォルダは表示しない
Public Const BIF_SHOW = &H2                 '特殊フォルダも表示する
Public Const BIF_FILES = &H4000             'ファイルも表示する

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

Private Function GetPointer(lngAddressOf As Long) As Long
    
    'コールバック関数のアドレスを返す
    GetPointer = lngAddressOf
End Function

Private Function BFFCallback(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    
    'フォルダを指定のメッセージをダイアログへ送信
    If uMsg = BFFM_INITIALIZED Then
        Call SendMessage(hwnd, BFFM_SETSELECTIONA, True, ByVal lpData)
    End If
End Function

'**************************************************
'* 関数名   : GetFolderDialog
'* 機  能   : 「フォルダ選択」ダイアログを表示する
'* 引  数   : lngHwnd    ウインドウのハンドル
'*            lngRoot    ルートディレクトリ
'*            strTitle   ダイアログタイトル
'*            strIniPath 初期パス
'*            lngFlag    フラグ
'* 戻り値   : フォルダ名
'**************************************************
Public Function GetFolderDialog(ByVal lngHwnd As Long, ByVal lngRoot As Long, ByVal strIniPath As String, _
                                ByVal strTitle As String, ByVal lngFlg As Long) As String
    
    On Error GoTo ErrTrap
    
    Dim BI      As BROWSEINFO   'BROWSEINFO構造体
    Dim strPath As String       'パス
    Dim lngRet  As Long         '戻り値
      
    With BI
        .hwndOwner = lngHwnd
        .lpszTitle = strTitle
        .pidlRoot = lngRoot
        .ulFlags = lngFlg
        .lpfn = GetPointer(AddressOf BFFCallback)
        .lParam = StrPtr(StrConv(strIniPath, vbFromUnicode) & vbNullChar)
    End With
    
    'フォルダを開くダイアログを表示
    lngRet = SHBrowseForFolder(BI)
    
    'バッファを確保
    strPath = String$(256, Chr$(0))

    If lngRet <> 0 Then
        
        'パスを取得
        Call SHGetPathFromIDList(lngRet, strPath)
        
        'パスを格納
        GetFolderDialog = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
    Else
        
        'キャンセル
        GetFolderDialog = ""
    End If
    
    Exit Function

ErrTrap:
    GetFolderDialog = ""
End Function

編集 削除

---

しゅうさん、
吉野さん

ありがとうございます。

吉野さんに記載していただいたモジュールを使用しまして、パス部分に初期値にしたい
パスを書きましたら、初期値に設定できました！！

モジュール部分で参照しているところなど、関数の意味がわからない部分もありますが、
みなさんの紹介してくださったHPや、本などでいろいろ調べて勉強します。

またわからないことがあった時はここに来てしまうと思いますが、よろしくお願いします。

ありがとうございました！！！

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。