◆概要
このページは、Microsoft AccessのVBAでフォルダを選択するダイアログを表示する方法を記載しています。

◆内容

Windows API を用いて、フォルダを選択するダイアログを表示する方法です。


フォーム上に FolderName というテキストボックスがあり、btn1 というコマンドボタンを押すことにより、フォルダ選択ダイアログを表示し、結果をテキストボックス[FolderName]にセットします。


1.モジュールを作成し、宣言 セクションに次の行を入力します。

Option Compare Database

Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260



Declare Function SHBrowseForFolder Lib "shell32" _
    (lpbi As BrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32" _
    (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
    (ByVal lpString1 As String, ByVal lpString2 As String) As Long

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 Sub btn1_Click()
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo

    szTitle = "〜するフォルダを選択し、[OK] を押してください"

    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
        Me!FolderName = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    End If

End Sub

◆実行結果

▼ページトップに戻る