Ordnerauswahl mit vorgegebenem Verzeichnis
04.07.2009
Ein Gast hatte heute in meinem Heimatforum die Frage gestellt, wie dem Windows Ordner-auswahldialog ein vorgegebenes Verzeichnis übergeben werden kann. Der Dialog soll dabei dieses Verzeichnis beim Aufruf markieren. Möglicherweise gibt es zu diesem Pro-
blem eine Windows Scripting Model Lösung, wir preferieren jedoch die API Variante, die wir hier kurz vorstellen.
Zunächst müssen wir unsere API Konstanten und Typen definieren sowie die passenden API Funktionen finden und importieren. Eine Liste der API Funktionen und Strukturen finden Sie übrigens bei MSDN, allerdings in Englisch.
Die API Funktion apiBrowseForFolder() zum Aufruf des Dialoges zur Ordnerauswahl bietet leider keinen Parameter, um ein Verzeichnis zu übergeben. Ebenso wenig kann der Typ apiTypeBrowseInfo dieses Verzeichnis in seinen Elementen aufnehmen. Dafür bietet uns diese Struktur jedoch den Parameter lpfn an. Und dieser ist sehr interessant, denn er ermöglicht uns einen Zeiger auf eine Funktion zu übergeben, die beim Aufruf des Dialoges ausgeführt werden soll. Diese Funktionen werden übrigens Callbacks genannt.
'
' Copyright : 2009 by Maninweb.de - www.excelsharp.de
'
' Version : 0100
'
' Disclaimer : Sie können diesen Code in Ihren Projekten
' frei verwenden.
' Wir würden uns freuen, wenn Sie diesen
' Hinweis auf den Autor beibehalten würden.
'
' .......................................................
' Optionen...
Option Explicit
' API Konstanten...
Public Const MAX_PATH As Long = 260
Public Const BFFM_INITIALIZED As Long = 1
Public Const BFFM_SETSELECTION As Long = &H466
Public Const LPTR As Long = &H40
' API Typen...
Public Type apiTypeBrowseInfo
hOwner 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
' API Importe...
Private Declare Function apiBrowseForFolder _
Lib "shell32" _
Alias "SHBrowseForFolderA" (lpmlthBrowseInfo As _
apiTypeBrowseInfo) As Long
Private Declare Function apiGetPathFromList _
Lib "shell32" _
Alias "SHGetPathFromIDListA" ( _
ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub apiCoTaskMemFree _
Lib "ole32" _
Alias "CoTaskMemFree" (ByVal pv As Long)
Private Declare Function apiSendMessage _
Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub apiCopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Declare Function apiLocalAlloc _
Lib "kernel32" _
Alias "LocalAlloc" (ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function apiLocalFree _
Lib "kernel32" _
Alias "LocalFree" (ByVal hMem As Long) As Long
Private Declare Function apiStrCopy _
Lib "kernel32" _
Alias "lstrcpyA" (lpString1 As Any, _
lpString2 As Any) As Long
Private Declare Function apiStrLength _
Lib "kernel32" _
Alias "lstrlenA" (lpString As Any) As Long
' Callbacks...
Private Function apiCallbackProc(ByVal Handle As Long, _
ByVal Message As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
Select Case Message
Case BFFM_INITIALIZED
apiSendMessage Handle, BFFM_SETSELECTION, 1&, ByVal lpData
Case Else
End Select
End Function
Private Function apiCallbackDummy(pfn As Long) As Long
apiCallbackDummy = pfn
End Function
' .......................................................
'
' Öffentliche Funktionen...
'
' .......................................................
Public Function BrowseForFolderByPath(Path As String, _
Title As String) As String
Dim t As apiTypeBrowseInfo
Dim p As Long
Dim n As Long
Dim s As String
' Pfad initialisieren...
s = String(MAX_PATH, " ")
' Struktur initialisieren...
t.pidlRoot = 0
t.lpszTitle = Title
t.lpfn = apiCallbackDummy(AddressOf apiCallbackProc)
' Speicher anfordern...
n = apiLocalAlloc(LPTR, Len(Path) + 1)
' Kopieren...
apiCopyMemory ByVal n, ByVal Path, Len(Path) + 1
' Länge übergeben...
t.lParam = n
' API Aufruf...
p = apiBrowseForFolder(t)
' Prüfen...
If p Then
If apiGetPathFromList(p, s) Then
BrowseForFolderByPath = Left(s, InStr(s, vbNullChar) - 1)
Else
BrowseForFolderByPath = ""
End If
apiCoTaskMemFree p
Else
BrowseForFolderByPath = ""
End If
apiLocalFree n
End Function
' Testfunktion...
Public Sub BrowseForFolderByPathTest()
Dim s As String
Dim t As String
' Einlesen...
s = ThisWorkbook.Worksheets("Start").Cells(14, 2).Value
' Abfragen...
If Len(s) > 0 Then
' Aufrufen...
t = BrowseForFolderByPath(s, "Test...")
' Prüfen...
If Len(t) > 0 Then
MsgBox t
End If
Else
MsgBox "Kein Verzeichnis angegeben."
End If
End Sub
Schauen wir uns mal die Funktion BrowseForFolderByPath() ein wenig genauer an.
Nun zunächst initialisieren wir eine unserer Variablen sowie Teile der Struktur vom
Typ apiTypeBrowseInfo, wie z.B. den Text, den der Ordnerauswahldialog anzeigen soll. Anschließend übergeben wir die Adresse unserer Callback-Funktion. Da wir aber die Adresse nicht so einfach direkt übergeben dürfen, kapseln wir dessen Rückgabe in
der Dummy Prozedur apiCallbackDummy().
Wenn Sie sich apiCallbackProc() im Code anschauen, werden Sie feststellen, dass genau nach der Initialisierung eine Windows Nachricht über apiSendMessage()an den Dialog gesendet wird. Dessen Parameter lpData sollte dann das vorgegebene Verzeichnis enthalten. Und wie kommt dieses dahin? Nun, wir kopieren unser Verzeichnis in einen bestimmten Speicherbereich und übergeben dessen Ort an t.lParam. Wenn dann der Ordnerauswahldialog über p = apiBrowseForFolder(t) aufgerufen wird, stehen dann alle Informationen zur Verfügung und der Dialog markiert das vorgegebene Verzeichnis. Dieses sollte natürlich existieren.
Sie können unsere Beispielanwendung mit dem Code herunterladen und beliebig für Ihre Zwecke anpassen. Unser Code wurde in Excel 2003 und 2007 auf Windows XP und Vista getestet. Trotzdem möchten wir Sie bitten, diesen Hinweis zu beachten: falls Sie mit API Funktionen experimentieren, schließen Sie zuvor alle wichtigen Dokumente und Anwendungen. Eine Gewähr oder Ähnliches kann nicht übernommen werden.
Blog
Neuigkeiten
