Vælg mappe, ikke fil!

Ved at bruge kontrollerne: "Drive listbox" og "Dir listbox" i Toolboksen

Hvad med lidt eksempelkode eventuelt?

'------------------------ Form1 ------------------------
Option Explicit

Private Sub Command1_Click()
  MsgBox BrowseFolder("Marker din mappen.", App.Path)
End Sub
'------------------------ Form1 ------------------------




'------------------------ Module1 ------------------------
Option Explicit

Private Declare Function SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (pidl As Any, 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 Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Private Type BROWSEINFO
    hwndOwner As Long
    pidlRoot As Long
    sDisplayName As String
    sTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Const MAX_PATH = 260&
Private Const WM_USER = &H400&

Private Const BIF_RETURNONLYFSDIRS As Long = &H1&
Private Const BFFM_INITIALIZED = 1&
Private Const BFFM_SETSELECTION = (WM_USER + 102&)

Dim m_sInitPath As String

Private Function GetCBaddr(ByVal lAddr As Long) As Long
    GetCBaddr = lAddr
End Function

Private Function BFCallBack(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    On Error Resume Next
    If uMsg = BFFM_INITIALIZED Then
        SendMessage hWnd, BFFM_SETSELECTION, 1&, ByVal m_sInitPath
    End If
End Function

Public Function BrowseFolder(Optional sPrompt As String = "", Optional sPath As String = "") As String
Dim BINF As BROWSEINFO
Dim lpItem As Long
Dim sDir As String
Dim iLen As Integer

  m_sInitPath = sPath
  If m_sInitPath <> "" Then
    iLen = Len(m_sInitPath)
    If iLen >= 2 Then
      If Right(m_sInitPath, 1) = "\" Then
        If iLen > 3 Then m_sInitPath = Left$(m_sInitPath, iLen - 1) 'not root - remove "\"
          Else
        If iLen < 3 Then m_sInitPath = m_sInitPath & "\"
      End If
      On Error GoTo EH_SBOA
      If Dir(m_sInitPath, vbDirectory) <> "" Then
        BINF.lpfn = GetCBaddr(AddressOf BFCallBack)
      End If
    End If
  End If

EH_SBOA:
On Error GoTo 0
  With BINF
      .hwndOwner = Screen.ActiveForm.hWnd
      .pidlRoot = 0&
      .sDisplayName = Space$(MAX_PATH + 1)
      .sTitle = sPrompt
      .ulFlags = BIF_RETURNONLYFSDIRS
  End With
  lpItem = SHBrowseForFolder(BINF)
  If lpItem Then
    sDir = Space$(MAX_PATH)
    If SHGetPathFromIDList(ByVal lpItem, sDir) Then
      BrowseFolder = Left(sDir, InStr(1, sDir, Chr(0)) - 1)
    End If
  End If
  GlobalFree lpItem
m_sInitPath = ""
End Function
'------------------------ Module1 ------------------------

Private Sub dirTil_Change()
    If Len(dirTil) > 3 Then
        Til = dirTil & "\"
    Else
        Til = dirTil
    End If
End Sub

Private Sub drvTil_Change()
    dirTil = drvTil
End Sub