MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - MOF-FAQ > MOF-FAQ - Module/VBA/VBE
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 11.01.2003, 17:33   #1
Stefan Kulpa
MS-Office-Forum Team MS-Office-Forum Team
Normal Wie erhalte ich einen Verzeichnisauswahldialog?

Der Dateiauswahldialog ist ein Windows eigener Systemdialog. Aus diesem Grund kann er von Windows Version zu Windows Version unterschiedlich aussehen – die Handhabung ist aber identisch.

Der Aufruf ist jedoch nur mittels des Win32-API möglich, ein entsprechendes ActiveX-Control wird (von Microsoft) nicht angeboten.

Leider(?) gibt es auch hier wieder unterschiedliche Möglichkeiten, diesen Dialog zu beeinflussen. Dies geschieht über folgende Konstanten:

Const BIF_BROWSEFORCOMPUTER = &H1000 Version 4.0. Nur Computer als Auswahl erlaubt. Wenn der Anwender andere Ordner markiert, kann der OK-Schalter nicht ausgewählt werden.
Const BIF_BROWSEFORPRINTER = &H2000 Version 4.0. Nur Drucker als Auswahl erlaubt. Wenn der Anwender andere Ordner markiert, kann der OK-Schalter nicht ausgewählt werden.
Const BIF_BROWSEINCLUDEFILES = &H4000 Version 4.71. Der Dialog zeigt neben den Ordnern auch Dateien.
Const BIF_BROWSEINCLUDEURLS = &H80 Version 5.0. Der Dialog kann auch URLs anzeigen.
Const BIF_DONTGOBELOWDOMAIN = &H2 Version 4.0. Der Dialog zeigt keine Netzwerkordner unterhalb der aktuellen Domain.
Const BIF_EDITBOX = &H10 Version 4.71. Dem Dialog wird eine Textbox hinzugefügt, 'um einen Eintrag einzugeben
Const BIF_NEWDIALOGSTYLE = &H40 Version 5.0. Das neue Benutzer-Design wird verwendet.
Const BIF_NONEWFOLDERBUTTON = &H200Version 4.0. Der Dialog enthält keine Schaltfläche "Neuen Ordner erstellen
Const BIF_RETURNFSANCESTORS = &H8 Version 4.0. Nur Dateisystemobjekte als Auswahl erlaubt. Wenn der Anwender andere Ordner markiert, kann der OK-Schalter nicht ausgewählt werden.
Const BIF_RETURNONLYFSDIRS = &H1 Version 4.0. Nur Dateisystemordner als Auswahl erlaubt. Wenn der Anwender andere Ordner markiert, kann der OK-Schalter nicht ausgewählt werden.
Const BIF_SHAREABLE = &H8000 Version 5.0. Der Dialog zeigt 'shareable' Ressourcen auf Netzwerksystem an.
Const BIF_STATUSTEXT = &H4 Version 4.0. Der Dialog enthält eine Statuszeile. Die Callback-Funktion kann die Statuszeile ausfüllen.
Const BIF_UAHINT = &H100 Version 4.0. Zusammen mit BIF_NEWDIALOGSTYLE wird anstelle der Eingabemöglichkeit ein Benutzerhinweis angezeigt
Const BIF_USENEWUI = &H40 Version 5.0. Zeigt ein neuen Dialog an mit mehr benutzerfreundlichen Änderungen
Const BIF_VALIDATE = &H20 Version 4.71. Sendet an die Callback Funktion eine BFFM_VALIDATEFAILED Message, wenn in der Textbox eine falsche Eingabe gemacht wurde


Diese Konstanten stehen in Abhängigkeit von der Shell32.dll-Version zur Verfügung. Dies sind:

VersionDLLBetriebssystem
4.00 alle Microsoft® Windows® 95/Windows NT® 4.0
4.71 alle Microsoft® Internet Explorer 4.0
5.00 Shlwapi.dll Microsoft® Internet Explorer 5
5.00 Shell32.dll Microsoft® Windows® 2000 und Windows Me


Um diese Konstanten nun einsetzen zu können, wird eine Struktur benötigt:

Type BROWSEINFO
     hOwner         As Long     Handle zum Elternfenster
     pidlRoot       As Long     für VB/A nicht relevant
     pszDisplayName As String   für VB/A nicht relevant
     lpszTitle      As String   Dialogtitel
     ulFlags        As Long     Flag für die Dialogeinstellung
     lpfn           As Long     Funktionsadresse (Callback)
     lParam         As Long     Wert für die Callback-Nutzung
     iImage         As Long     für VB/A nicht relevant
End Type

In diesem Beispiel wird jedoch von der einfachsten Art der Nutzung des Auswahldialogs ausgegangen:

Code:

Type BROWSEINFO
     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
 
Const BIF_BROWSEFORCOMPUTER = &H1000
Const BIF_BROWSEFORPRINTER = &H2000
Const BIF_BROWSEINCLUDEFILES = &H4000
Const BIF_BROWSEINCLUDEURLS = &H80
Const BIF_DONTGOBELOWDOMAIN = &H2
Const BIF_EDITBOX = &H10
Const BIF_NEWDIALOGSTYLE = &H40
Const BIF_NONEWFOLDERBUTTON = &H200
Const BIF_RETURNFSANCESTORS = &H8
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_SHAREABLE = &H8000
Const BIF_STATUSTEXT = &H4
Const BIF_UAHINT = &H100
Const BIF_USENEWUI = &H40
Const BIF_VALIDATE = &H20
 
Declare Function GetActiveWindow Lib "user32" () As Long
 
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
                "SHBrowseForFolderA" _
                (lpBrowseInfo As BROWSEINFO) As Long
 
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
                "SHGetPathFromIDListA" _
                (ByVal pidl As Long, _
                 ByVal pszPath As String) As Long
 
Declare Sub CoTaskMemFree Lib "OLE32.dll" (ByVal pv As Long)
 
Function Ordnerauswahl() As String
 
    Const MAXPATH               As Long = 260
    Dim uBrowseInfo             As BROWSEINFO
    Dim sPath                   As String
    Dim lPidl                   As Long
'// -------------------------------------------------------------
'// Das Elternfenster bestimmen
'// -------------------------------------------------------------
    uBrowseInfo.hOwner = GetActiveWindow()
'// -------------------------------------------------------------
'// pidlRoot ist zwar irrelevant, muss aber auf 0 gesetzt werden
'// -------------------------------------------------------------
    uBrowseInfo.pidlRoot = 0&
'// -------------------------------------------------------------
'// Flag auf "nur Ordner" setzen
'// -------------------------------------------------------------
    uBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
'// -------------------------------------------------------------
'// Dialogtitel setzen
'// -------------------------------------------------------------
    uBrowseInfo.lpszTitle = "Bitte wählen Sie ein Verzeichnis:"
'// -------------------------------------------------------------
'// Funktion aufrufen
'// -------------------------------------------------------------
    lPidl = SHBrowseForFolder(uBrowseInfo)
'// -------------------------------------------------------------
'// String-Buffer für API-Aufruf dimensionieren !!!
'// -------------------------------------------------------------
    sPath = VBA.Space$(MAXPATH)
'// -------------------------------------------------------------
'// Ergebnis "abholen"
'// -------------------------------------------------------------
    If SHGetPathFromIDList(ByVal lPidl, ByVal sPath) Then
    '// ---------------------------------------------------------
    '// Bei Erfolg Rückgabewert ermitteln
    '// ---------------------------------------------------------
        Ordnerauswahl = Left(sPath, InStr(sPath, vbNullChar) - 1)
    End If
'// -------------------------------------------------------------
'// Wichtig: Speicher freigeben !!!
'// -------------------------------------------------------------
    Call CoTaskMemFree(lPidl)
 
End Function
 
Sub Beispiel()
 
    Dim sFolder As String
    sFolder = Ordnerauswahl()
    If Len(sFolder) > 0 Then
        MsgBox "Der Ordner " & sFolder & " wurde gewählt!", vbInformation
    End If
 
End Sub
Code eingefügt mit dem MOF Code Converter

Geändert von Manuela Kulpa (11.01.2003 um 17:38 Uhr).
Stefan Kulpa ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 17.03.2003, 14:03   #2
Sascha Trowitzsch
MS-Office-Forum Team MS-Office-Forum Team
Standard

Die einfachste Variante, um den Verzeichnisauswahl-Dialog zu erhalten, ist der entsprechende Aufruf aus der Shell32.dll.
Da diese eine ActiveX-DLL und in jedem Windows enthalten ist, können viele Systemfunktionen auf einfache Weise ohne API und Sorge um Kompatibilität aufgerufen werden.
Eine gute Übersicht kann man unter
http://www.shadoware.de/vb/tutorials/shell32.html
finden.
Voraussetzung ist ein Verweis auf diese DLL im VB-Editor, der sich 'Microsoft Shell Controls And Automation' nennt.


Microsoft macht außerdem in der MSDN folgende Aussagen zum Object Shell.Application:

Minimum DLL version:
shell32.dll version 4.71 or later

Minimum operating systems:
Windows 2000, Windows NT 4.0 with Internet Explorer 4.0, Windows 98, Windows 95 with Internet Explorer 4.0


Einen Order mit dem entspr. Shell-Dialog erhält man mit folgender Funktion:

Code:

 
'Shell Funktion: Function BrowseForFolder(Hwnd As Long, Title As String, Options As Long, [RootFolder]) As Folder
 
Function GetFolder(Optional Caption, Optional StartFolder, Optional lOptions) As String
Dim SH As New Shell
On Error Resume Next    'Notwendig, falls der Abbrechen-Button betätigt wird; Ergebnis ist dann ""
    If IsMissing(Caption) Then Caption = ""
    GetFolder = CStr(SH.BrowseForFolder(0, Caption, lOptions, StartFolder))
End Function
Mit Caption kann ein Titel-String angegeben werden.
Mit StartFolder kann ein Verzeichnis-String als Startverzeichnis angegeben werden.
lOptions ist eine Kombination von Konstanten. Es sind die gleichen, die Stefan oben aufgelistet hat (BIF_-Konstanten).

Alternativ funktioniert das Ganze auch ohne Verweis :
Code:

Function GetFolder(Optional Caption, Optional StartFolder, Optional lOptions) As String
Dim SH As Object
On Error Resume Next
    Set SH = CreateObject("Shell.Application")
    If IsMissing(Caption) Then Caption = ""
    GetFolder = CStr(SH.BrowseForFolder(0, Caption, lOptions, StartFolder))
    Set SH = Nothing
End Function
 
Beispiel für einen Aufruf:

strFolder = GetFolder( , "C:\", &H40)

Ciao, Sascha

Update:

Nach Update von W2000 auf SP4 funktioniert die Funktion nicht mehr wie gewünscht. Sie gibt nur noch den Verzeichnisnamen zurück, nicht jedoch den gesamten Pfad.
Es notwendig, die Funktion folgendermaßen umzuschreiben:

Code:

Function GetFolder(Optional Caption, Optional StartFolder, Optional lOptions) As String
Dim SH As Object, SF As Object
    Set SH = CreateObject("Shell.Application")
    If IsMissing(Caption) Then Caption = ""
    If IsMissing(StartFolder) Then StartFolder = "c:\"
    If IsMissing(lOptions) Then lOptions = &H40
    Set SF = SH.BrowseForFolder(0, Caption, lOptions, StartFolder)
    If SF Is Nothing Then Exit Function
    GetFolder = SF.Self.Path
    Set SH = Nothing
    Set SF = Nothing
End Function
Code eingefügt mit dem MOF Code Converter

Geändert von Sascha Trowitzsch (14.07.2004 um 10:48 Uhr).
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 15.07.2004, 08:26   #3
DarthPatrick
MOF Profi
MOF Profi
Standard

@Sascha: Vielen Dank für diesen super Tipp!! Leider habe ich ein Problem und bekomme es selber nicht in den Griff: NT40, SP6, IE5.0 gibt mir mit der ersten Funktion nur den Verzeichnisnamen und nicht den Pfad zurück. Die zweite Funktion scheitert mit dem Fehler "Objekt unterstützt diese Eigenschaft oder Methode nicht" in der Zeile GetFolder=SF.Self.Path

Ich vermute jetzt mal, dass SF kein Object sondern irgendwas anderes sein muss - habe bnis jetzt aber noch nicht so recht herausbekommen was - oder liegt der Fehler ganz woanders ?!

__________________

Gruß
Patrick

Software: Access97, SQL-Server 2000, PostgreSQL auf cygwin und Linux, Windows98, NT und XP
DarthPatrick ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 16.10.2007, 20:23   #4
Toast78
MOF Profi
MOF Profi
Standard

Ich hätt da auch nochmal einen kleinen Tipp: Und zwar wollte ich auf möglichst einfache Art und Weise mittels shell32.dll den gesamten Pfad und nicht nur den Namen des Ordners selbst ermitteln.
Dazu habe ich folgendes kleines Beispiel:
Code:

Public Sub oeffneOrdner()
Dim schale As New Shell
Dim ordner As Folder2
Set ordner = schale.BrowseForFolder(0, "Verzeichnisdialog", &H40, "G:\")
Debug.Print ordner.Self.Path
End Sub

__________________

Bunt ist das Dasein & granatenstark ;o)
Toast78 ist gerade online  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 08:20 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.