MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Access & Datenbanken > Microsoft Access - Code Archiv
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 28.12.2002, 10:29   #1
Günther Kramer
MS-Office-Forum Team MS-Office-Forum Team
Nachricht Codebeispiel - Verzeichnisauswahldialog für Access 97



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.
Die besonderheit bei diesem Beispiel ist, dass man hier auch ein Startverzeichnis angeben kann.

Erstellen Sie ein neues Modul und fügen Sie nachfolgenden Code ein:

Code:

Option Compare Database
Option Explicit
 
Private 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
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
 
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
 
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
            (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) _
            As Long
 
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = 1
 
Global StartDir As String
 
Public Function VerzeichnisSuchen(szDialogTitle As String, _
                StartVerzeichnis As String) As String
 
  Dim X         As Long
  Dim bi        As BROWSEINFO
  Dim dwIList   As Long
  Dim szPath    As String
  Dim wPos      As Integer
 
  StartDir = StartVerzeichnis
 
  With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))
    End With
 
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
 
    If X Then
        wPos = InStr(szPath, Chr(0))
        VerzeichnisSuchen = Left$(szPath, wPos - 1)
    Else
        VerzeichnisSuchen = ""
    End If
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                ByVal lParam As Long, ByVal lpData As Long) As Long
 
    Dim pathstring  As String
    Dim retval      As Long
 
    Select Case uMsg
        Case BFFM_INITIALIZED
            pathstring = StartDir '"C:\Temp"
            retval = SendMessage(hWnd, BFFM_SETSELECTION, _
                     ByVal CLng(1), ByVal pathstring)
    End Select
 
    BrowseCallbackProc = 0
 
End Function
Public Function DummyFunc(ByVal param As Long) As Long
 
    DummyFunc = param
 
End Function
Da Access 97 die Funktion AddressOf nicht kennt, müssen Sie nur für die Access 97-Version ein zweites Modul erstellen. Kopieren Sie die folgenden Codezeilen in das neue Modul.

Code:

Option Compare Database
Option Explicit
 
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias _
"EbGetExecutingProj" (hProject As Long) As Long
 
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hProject As Long, ByVal strFunctionName As String, ByRef _
strFunctionId As String) As Long
 
Private Declare Function GetAddr Lib "vba332.dll" Alias _
"TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionId As _
String, ByRef lpfn As Long) As Long
 
Public Function AddrOf(strFuncName As String) As Long
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String
 
Const NO_ERROR = 0
 
' The function name must be in Unicode, so convert it.
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
 
' Get the current VBA project
' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
' so now we just check the project handle when the function returns.
Call GetCurrentVbaProject(hProject)
 
' Make sure we got a project handle... we always should, but you never know!
If hProject <> 0 Then
    ' Get the VBA function ID (whatever that is!)
    lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
 
    ' We have to check this because we GPF if we try to get a function pointer
    ' of a non-existent function.
    If lngResult = NO_ERROR Then
        ' Get the function pointer.
        lngResult = GetAddr(hProject, strID, lpfn)
 
        If lngResult = NO_ERROR Then
            AddrOf = lpfn
        End If
    End If
End If
 
End Function
Um den Dialog aufzurufen und das Ergebnis einem Feld innerhalb des Formulars zurückzugeben erstellen Sie bitte eine Schaltfläche mit dem Namen Verzeichnisauswahl. Der im Beispiel verwendete Namen für das Feld, in welches der Verzeichnispfad zurückgeschrieben wird, lautet Verzeichnis. Beide Namen (Schaltfläche & Feld) können Sie natürlich anders benennen.

Code:

Private Sub Verzeichnisauswahl_Click()
 
    Dim strVerzeichnisName As String
 
    If IsNull(Me!Verzeichnis) Then
        Me!Verzeichnis = ""
    End If
 
    strVerzeichnisName = VerzeichnisSuchen _
        ("Wählen Sie bitte das Verzeichnis aus!", Me!Verzeichnis)
 
    If ((Not IsNull(strVerzeichnisName)) And (strVerzeichnisName <> "")) Then
        Me!Verzeichnis = strVerzeichnisName
    End If
 
End Sub
Angehängte Dateien
Dateityp: zip ap_verzeichnisauswahldialog_erweitert_a97.zip (54,1 KB, 193x aufgerufen)

__________________

Gruß, Günther


Tools und Lösungen für Microsoft Access
Günther Kramer ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 29.07.2003, 13:02   #2
Sascha Trowitzsch
MS-Office-Forum Team MS-Office-Forum Team
Standard

Alternativen gibt es auch unter http://www.ms-office-forum.net/forum...threadid=95650

__________________

Microsoft Access MVP
O2k bis O2010, VB6, VS2008, Delphi7, ...
Bitte keine ungefragten E-Mails. Probleme werden hier gelöst.
Bitte beachten: Grundlegendes zum Access-Forum

Knowhow auf Access-im-Unternehmen | Das Access 2007 Praxisbuch für Entwickler | www.mossTOOLs.de
Sascha Trowitzsch ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.11.2005, 08:31   #3
ibens
Neuer Benutzer
Neuer Benutzer
Standard

Hallo !!!

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

Gruss
ibens
ibens ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.11.2005, 04:35   #4
TommyK
MS-Office-Forum Team MS-Office-Forum Team
Standard

Hallo ibens,

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

__________________

Gruss TommyK


TKSoft-Online | Beispiele im MOF Code-Archiv
Meine Software:Windows 10 Pro 64Bit, Windows 7 Ultimate 64Bit, Office 2003 Pro SP3, Office 2007 Pro SP2, Office 2010 Pro, VB6 Pro SP6, VS2008

TommyK ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.03.2013, 14:15   #5
hanspeterludwig
MOF User
MOF User
Standard Sub oder Function nicht definiert

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 ...
hanspeterludwig ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.03.2013, 21:53   #6
Marsu65
MOF Guru
MOF Guru
Standard

Hallo,
ersetze die Zeile
Code:

.lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))
durch
Code:

.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.

Geändert von Marsu65 (11.03.2013 um 21:56 Uhr).
Marsu65 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 27.04.2016, 16:46   #7
MaggieMay
MOF Koryphäe
MOF Koryphäe
Standard

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:
Code:

        .lpfn = DummyFunc(AddrOf("BrowseCallbackProc"))
Ich bekomme nämlich in der folgenden Zeile:
Code:

    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.

__________________

Gruß Maggie
MaggieMay ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.04.2016, 16:20   #8
uwek
MOF Koryphäe
MOF Koryphäe
Standard

Hallo Maggie,

Dieser hier sollte deine Erwartungen erfüllen.

__________________



Gruss Uwe

Win 10, Office 365, VB6 SP6, VB2008 Express
Links:

HP | Kalender-Demo | CodeHelper | xlNavi

uwek ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.04.2016, 16:56   #9
MaggieMay
MOF Koryphäe
MOF Koryphäe
Standard

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?
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:

Zitat: von Marsu65 Beitrag anzeigen

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.

__________________

Gruß Maggie
MaggieMay ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.04.2016, 17:03   #10
uwek
MOF Koryphäe
MOF Koryphäe
Standard

Schau mal hier im Forum

__________________



Gruss Uwe

Win 10, Office 365, VB6 SP6, VB2008 Express
Links:

HP | Kalender-Demo | CodeHelper | xlNavi

uwek ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 28.04.2016, 17:23   #11
MaggieMay
MOF Koryphäe
MOF Koryphäe
Standard

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.

__________________

Gruß Maggie
MaggieMay ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 29.04.2016, 09:14   #12
JPA
MOF Koryphäe
MOF Koryphäe
Standard

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

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
JPA ist offline  
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 21:11 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.