PDA

Vollständige Version anzeigen : Verzeichnisauswahldialog für Access 97


Günther Kramer
28.12.2002, 11:29
<img src="images/codearchiv/verzeichnisauswahldialog.gif" border=0><br><br>Mit dieser Funktion stellen Sie einen Auswahldialog zur Verfügung, mit dessen Hilfe der Anwender ein gewünschtes Verzeichnis auswählen kann. Der Verzeichnispfad wird als String an die Funktion zurückgegeben.<br>Die besonderheit bei diesem Beispiel ist, dass man hier auch ein Startverzeichnis angeben kann.<br><br>Erstellen Sie ein neues Modul und fügen Sie nachfolgenden Code ein:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Compare</span> <span class="TOKEN">Database</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Type</span> BROWSEINFO
hOwner <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
pidlRoot <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
pszDisplayName <span class="TOKEN">As</span> <span class="TOKEN">String</span>
lpszTitle <span class="TOKEN">As</span> <span class="TOKEN">String</span>
ulFlags <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
lpfn <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
lParam <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
iImage <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">End</span> <span class="TOKEN">Type</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> SHGetPathFromIDList <span class="TOKEN">Lib</span> &quot;shell32.dll&quot; <span class="TOKEN">Alias</span> _
&quot;SHGetPathFromIDListA&quot; (<span class="TOKEN">ByVal</span> pidl <span class="TOKEN">As</span> Long, _
<span class="TOKEN">ByVal</span> pszPath <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> SHBrowseForFolder <span class="TOKEN">Lib</span> &quot;shell32.dll&quot; <span class="TOKEN">Alias</span> _
&quot;SHBrowseForFolderA&quot; (lpBrowseInfo <span class="TOKEN">As</span> BROWSEINFO) _
<span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> SendMessage <span class="TOKEN">Lib</span> &quot;user32.dll&quot; <span class="TOKEN">Alias</span> &quot;SendMessageA&quot; _
(<span class="TOKEN">ByVal</span> hWnd <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> Msg <span class="TOKEN">As</span> Long, wParam <span class="TOKEN">As</span> Any, lParam <span class="TOKEN">As</span> Any) _
<span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Const</span> BIF_RETURNONLYFSDIRS = &amp;H1
<span class="TOKEN">Private</span> <span class="TOKEN">Const</span> BFFM_SETSELECTION = &amp;H466
<span class="TOKEN">Private</span> <span class="TOKEN">Const</span> BFFM_INITIALIZED = 1
&nbsp;
<span class="TOKEN">Global</span> StartDir <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">Public Function</span> VerzeichnisSuchen(szDialogTitle <span class="TOKEN">As</span> String, _
StartVerzeichnis <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">Dim</span> X <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> bi <span class="TOKEN">As</span> BROWSEINFO
<span class="TOKEN">Dim</span> dwIList <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> szPath <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> wPos <span class="TOKEN">As</span> <span class="TOKEN">Integer</span>
&nbsp;
StartDir = StartVerzeichnis
&nbsp;
<span class="TOKEN">With</span> bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = DummyFunc(AddrOf(&quot;BrowseCallbackProc&quot;))
<span class="TOKEN">End</span> <span class="TOKEN">With</span>
&nbsp;
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(<span class="TOKEN">ByVal</span> dwIList, <span class="TOKEN">ByVal</span> szPath)
&nbsp;
<span class="TOKEN">If</span> X <span class="TOKEN">Then</span>
wPos = InStr(szPath, Chr(0))
VerzeichnisSuchen = Left$(szPath, wPos - 1)
<span class="TOKEN">Else</span>
VerzeichnisSuchen = &quot;&quot;
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">Function</span>
<span class="TOKEN">Public Function</span> BrowseCallbackProc(<span class="TOKEN">ByVal</span> hWnd <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> uMsg <span class="TOKEN">As</span> Long, _
<span class="TOKEN">ByVal</span> lParam <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> lpData <span class="TOKEN">As</span> <span class="TOKEN">Long</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Dim</span> pathstring <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> retval <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
Select Case uMsg
Case BFFM_INITIALIZED
pathstring = StartDir <span class="REM">'&quot;C:\Temp&quot;</span>
retval = SendMessage(hWnd, BFFM_SETSELECTION, _
<span class="TOKEN">ByVal</span> <span class="TOKEN">CLng</span>(1), <span class="TOKEN">ByVal</span> pathstring)
<span class="TOKEN">End</span> Select
&nbsp;
BrowseCallbackProc = 0
&nbsp;
<span class="TOKEN">End</span> <span class="TOKEN">Function</span>
<span class="TOKEN">Public Function</span> DummyFunc(<span class="TOKEN">ByVal</span> param <span class="TOKEN">As</span> <span class="TOKEN">Long</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
DummyFunc = param
&nbsp;
<span class="TOKEN">End</span> <span class="TOKEN">Function</span>
</pre></div>
Da Access 97 die Funktion <b>AddressOf</b> nicht kennt, müssen Sie <b>nur</b> für die Access 97-Version ein zweites Modul erstellen. Kopieren Sie die folgenden Codezeilen in das neue Modul.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Option</span> <span class="TOKEN">Compare</span> <span class="TOKEN">Database</span>
<span class="TOKEN">Option</span> <span class="TOKEN">Explicit</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> GetCurrentVbaProject <span class="TOKEN">Lib</span> &quot;vba332.dll&quot; <span class="TOKEN">Alias</span> _
&quot;EbGetExecutingProj&quot; (hProject <span class="TOKEN">As</span> <span class="TOKEN">Long</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> GetFuncID <span class="TOKEN">Lib</span> &quot;vba332.dll&quot; <span class="TOKEN">Alias</span> &quot;TipGetFunctionId&quot; _
(<span class="TOKEN">ByVal</span> hProject <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> strFunctionName <span class="TOKEN">As</span> String, <span class="TOKEN">ByRef</span> _
strFunctionId <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Private</span> <span class="TOKEN">Declare</span> <span class="TOKEN">Function</span> GetAddr <span class="TOKEN">Lib</span> &quot;vba332.dll&quot; <span class="TOKEN">Alias</span> _
&quot;TipGetLpfnOfFunctionId&quot; (<span class="TOKEN">ByVal</span> hProject <span class="TOKEN">As</span> Long, <span class="TOKEN">ByVal</span> strFunctionId <span class="TOKEN">As</span> _
String, <span class="TOKEN">ByRef</span> lpfn <span class="TOKEN">As</span> <span class="TOKEN">Long</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
&nbsp;
<span class="TOKEN">Public Function</span> AddrOf(strFuncName <span class="TOKEN">As</span> <span class="TOKEN">String</span>) <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> hProject <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> lngResult <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> strID <span class="TOKEN">As</span> <span class="TOKEN">String</span>
<span class="TOKEN">Dim</span> lpfn <span class="TOKEN">As</span> <span class="TOKEN">Long</span>
<span class="TOKEN">Dim</span> strFuncNameUnicode <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">Const</span> NO_ERROR = 0
&nbsp;
<span class="REM">' The function name must be in Unicode, so convert it.</span>
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
&nbsp;
<span class="REM">' Get the current VBA project</span>
<span class="REM">' The results of GetCurrentVBAProject seemed inconsistent, in our tests,</span>
<span class="REM">' so now we just check the project handle when the function returns.</span>
<span class="TOKEN">Call</span> GetCurrentVbaProject(hProject)
&nbsp;
<span class="REM">' Make sure we got a project handle... we always should, but you never know!</span>
<span class="TOKEN">If</span> hProject &lt;&gt; 0 <span class="TOKEN">Then</span>
<span class="REM"> ' Get the VBA function ID (whatever that is!)</span>
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
&nbsp;
<span class="REM"> ' We have to check this because we GPF if we try to get a function pointer</span>
<span class="REM"> ' of a non-existent function.</span>
<span class="TOKEN">If</span> lngResult = NO_ERROR <span class="TOKEN">Then</span>
<span class="REM"> ' Get the function pointer.</span>
lngResult = GetAddr(hProject, strID, lpfn)
&nbsp;
<span class="TOKEN">If</span> lngResult = NO_ERROR <span class="TOKEN">Then</span>
AddrOf = lpfn
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
&nbsp;
<span class="TOKEN">End</span> <span class="TOKEN">Function</span></pre></div>

Um den Dialog aufzurufen und das Ergebnis einem Feld innerhalb des Formulars zurückzugeben erstellen Sie bitte eine Schaltfläche mit dem Namen <b>Verzeichnisauswahl</b>. Der im Beispiel verwendete Namen für das Feld, in welches der Verzeichnispfad zurückgeschrieben wird, lautet <b>Verzeichnis</b>. Beide Namen (Schaltfläche & Feld) können Sie natürlich anders benennen.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre><span class="TOKEN">Private Sub</span> Verzeichnisauswahl_Click()
&nbsp;
<span class="TOKEN">Dim</span> strVerzeichnisName <span class="TOKEN">As</span> <span class="TOKEN">String</span>
&nbsp;
<span class="TOKEN">If</span> IsNull(Me!Verzeichnis) <span class="TOKEN">Then</span>
Me!Verzeichnis = &quot;&quot;
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
&nbsp;
strVerzeichnisName = VerzeichnisSuchen _
(&quot;W&auml;hlen Sie bitte das Verzeichnis aus!&quot;, Me!Verzeichnis)
&nbsp;
<span class="TOKEN">If</span> ((<span class="TOKEN">Not</span> IsNull(strVerzeichnisName)) <span class="TOKEN">And</span> (strVerzeichnisName &lt;&gt; &quot;&quot;)) <span class="TOKEN">Then</span>
Me!Verzeichnis = strVerzeichnisName
<span class="TOKEN">End</span> <span class="TOKEN">If</span>
&nbsp;
<span class="TOKEN">End</span> <span class="TOKEN">Sub</span></pre></div>

Sascha Trowitzsch
29.07.2003, 14:02
Alternativen gibt es auch unter http://www.ms-office-forum.net/forum/showthread.php?s=&threadid=95650

ibens
02.11.2005, 09:31
Hallo !!!

Wie kann ich dann Pfad des ausgewählten Ordners in eine Tabele speichern???

Gruss
ibens

TommyK
03.11.2005, 05:35
Hallo ibens,

das musst Du mal genauer erläutern was wo wie machen willst.

hanspeterludwig
08.03.2013, 15:15
Hallo Miteinander,

bin gerade dabei dieses Modul in eine Anwendung zu einzubinden.

Leider bekomme ich diese Meldung "Sub oder Function nicht definiert".

Es wird die Zeile:
.lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))

markiert. Was habe ich falsch gemacht? Arbeite mit der Version 2003 ...

Danke für die Hilfe ...

Marsu65
11.03.2013, 22:53
Hallo,
ersetze die Zeile
.lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))
durch .lpfn = DummyFunc(AddressOf BrowseCallbackProc)


PS: Schau dir mal die Bsp. aus Saschas Link an.
Vor allem den von ihm gezeigten 12-Zeiler finde ich besser.

MaggieMay
27.04.2016, 17:46
Hallo miteinander,

ich hoffe, hier schaut nochmal jemand rein, ich hätte nämlich zum Beitrag von Günther die folgende Frage...
Was bewirkt dieser Befehl:

.lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))

Ich bekomme nämlich in der folgenden Zeile:
Call GetCurrentVbaProject(hProject)einen Fehler bzgl. vba332.dll, welche nicht gefunden wird (und auch nicht vorhanden ist).

Wenn ich nun einfach .lpfn auf 0 setze, scheint alles zu funktionieren.
Was also bewirkt der Aufruf von "DummyFunc" bzw. was macht die "BrowseCallbackProc"?
Ich muss gestehen, das ganze Konstrukt ist mir unklar.

Wenn die o.g. Lösung nicht mehr zeitgemäß ist, so würde ich mich über einen Hinweis auf einen alternativen Verzeichnisauswahldialog mit Vorgabe eines Startordners und frei wählbarem Titel freuen.

uwek
28.04.2016, 17:20
Hallo Maggie,

Dieser hier (http://www.vbarchiv.net/tipps/tipp_1089-browseforfolder-mit-extra-funktionen.html) sollte deine Erwartungen erfüllen.

MaggieMay
28.04.2016, 17:56
Hallo Uwe,

vielen Dank für den Link, aber ich hatte ehrlich gesagt auf eine "schlankere" Lösung gehofft. Werden die ganzen API-Deklarationen tatsächlich alle benötigt? :eek:
Ich bin nämlich dabei, eine Anwendung für Office 64 Bit zum Laufen zu bringen und bei der Umschreibung des Codes bin ich ziemlich am Schwimmen, es läuft mehr oder weniger auf Try & Error hinaus, was echt mühsam und zeitaufwändig ist.

Außerdem ist da ja auch wieder die CallBack-Funktion mit drin, kannst du mir erklären wozu genau die gut ist?

Ich hatte auch schon diesen Tipp ausprobiert:
PS: Schau dir mal die Bsp. aus Saschas Link an.
Vor allem den von ihm gezeigten 12-Zeiler finde ich besser.der bei der 32 Bit Version prima klappt, mit 64 Bit aber einen Datentypenfehler bringt. Das ist wieder die Krux, dass nirgendwo richtig dokumentiert zu sein scheint, was genau anzupassen ist. :(

uwek
28.04.2016, 18:03
Schau mal hie (http://www.ms-office-forum.net/forum/showthread.php?t=263854)r im Forum

MaggieMay
28.04.2016, 18:23
Vielen lieben Dank, das sollte wohl auch mir helfen!

Die dort verlinkte Seite kannte ich sogar schon, hatte nur nicht bemerkt, dass ein Teil genau dieses Beispiels dort zur Demonstration der bedingten Kompilierung verwendet wurde.

JPA
29.04.2016, 10:14
Mir gefällt das Dialog-Fenster sehr gut, leider kann es nicht vergrößert werden, daher verwende ich lieber diese Lösung:

Public Function GetFilename(Action As Long, SelectedItems() As String, Optional dlgTitle As String, Optional OpenButtonTitle As String _
, Optional IniFile As String, Optional IniDir As String _
, Optional Filter As String = "", Optional FilterIndex As Long, Optional View As Long, Optional FileMustExist As Boolean = True) As Boolean
DoCmd.Hourglass False
Select Case Action
Case 2 'Mehrfachauswahl
Action = 8
Case 3 'Ordnerauswahl
Action = 32
Case Else 'Einzelauswahl (nur eine Datei)
Action = 4
End Select
If View >= 0 Then Action = Action + 64 Else View = 0
WizHook.Key = 51488399
If WizHook.GetFilename(0, "", dlgTitle, OpenButtonTitle, IniFile, IniDir, Filter, FilterIndex, View, Action, FileMustExist) = 0 Then
SelectedItems = Split(IniFile, vbTab)
GetFilename = True
End If
End Function


Und es ist eine Lösung für beides (Datei und Ordner pickup).

Gruß
JPA