Hejsan,

Är det möjligt att använda commondialogs till att välja katalog och inte fil? Funderade på att lägga en extra knapp inne i rutan med API, men hellst slipper jag.

Alternativa lösningar till problemet tages oxå emot.

Bör nämna att det är VBA/Access som gäller och att dirlist-grejjen i VB inte finns.

Bra också om jag slipper lägga till fler komponenter.

Mvh,
/Robert

Finns ett api anrop som är bra för att låtaanvändaren ange en mapp.

Klistra in följande kod i en modul:

Option Compare Database
Option Explicit

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

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

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

Private Declare Function lstrcat Lib "kernel32" 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

Public Function BrowseForFolder(szTitle As String, Optional Owner As Form) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
szTitle = "This is the title"
With tBrowseInfo
If Owner Is Nothing Then
.hWndOwner = hWndAccessApp
Else
.hWndOwner = Owner.Hwnd
End If
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = String(MAX_PATH, 0&)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
Else
Err.Raise vbObjectError + 18, "BrowseForFolder", "BrowseForFolder was canceled"
End If
End Function

Du använderfunktione såhär:
(Formulär med två kontroller TextBox: txtFolder och CommandButton: cmdBrows)

Private Sub cmdBrows_Click()
On Error GoTo cmdBrows_Click_Err

txtFolder = BrowseForFolder("Ange katalog", Me)

cmdBrows_Click_Exit:
Exit Sub

cmdBrows_Click_Err:
Select Case Err.Number
Case vbObjectError + 18
Resume cmdBrows_Click_Exit
Case Else
MsgBox Err.Description, vbCritical
Resume cmdBrows_Click_Exit
End Select

End Sub

Stort tack!