vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Erstellen von dynamischen Kontextmen?s - wann immer Sie sie brauchen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2021
 
zurück
Rubrik:    |   VB-Versionen: VB5, VB601.09.03
Ordnerauswahl-Dialog mit Startverzeichnis

Dieser Tipp erweitert die BrowseForFolder-Funktion um die Möglichkeit eienn bestimmten Start-Ordner vorzuselektieren.

Autor:   Dieter OtterBewertung:     [ Jetzt bewerten ]Views:  1.200 
http://www.tools4vb.de/System:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt 

In unserer Workshop-Rubrik finden Sie u.a. einen Code, mit dem man den Standard-Dialog zur Ordnerauswahl verwenden kann. Leider lässt sich hier kein "Start-Ordner" festlegen, der beim Aufruf des Dialogs autom. vorselektiert ist. Wie sich die "BrowseForFolder"-Funktion um genau dieses Feature erweitern lässt, das erfahren Sie in unserem Extra-Tipp September 2003.

Fügen Sie hierzu den nachfolgenden Code in ein Modul ein:

Option Explicit
 
' Benötigte API-Deklarationen
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
 
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = 1
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" ( _
  ByVal hMem As Long)
 
Private Declare Function lstrcat Lib "kernel32" _
  Alias "lstrcatA" ( _
  ByVal lpString1 As String, _
  ByVal lpString2 As String) As Long
 
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Declare Function SHGetPathFromIDList Lib "shell32" ( _
  ByVal pidList As Long, _
  ByVal lpBuffer As String) As Long
 
Private Declare Function SHBrowseForFolder Lib "shell32" ( _
  lpbi 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 m_BrowseInitDir As String
' Ordnerauswahl-Dialog mit optionaler 
' Angabe eines Startverzeichnisses
Public Function BrowseForFolder(ByVal sPrompt As String, _
  Optional ByVal sInitDir As String) As String
 
  Dim nPos As Long
  Dim nIDList As Long
  Dim sPath As String
  Dim oInfo As BrowseInfo
 
  m_BrowseInitDir = sInitDir
 
  ' Datenstruktur füllen
  With oInfo
    .hWndOwner = GetActiveWindow()
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = BIF_RETURNONLYFSDIRS
    If sInitDir <> "" Then
      ' Callback-Funktionsadresse
      .lpfnCallback = FuncCallback(AddressOf BrowseCallback)
    End If
  End With
 
  ' Dialog anzeigen und auswerten
  nIDList = SHBrowseForFolder(oInfo)
  If nIDList Then
    sPath = String$(MAX_PATH, 0)
    Call SHGetPathFromIDList(nIDList, sPath)
    Call CoTaskMemFree(nIDList)
    nPos = InStr(sPath, vbNullChar)
    If nPos Then sPath = Left$(sPath, nPos - 1)
  End If
 
  BrowseForFolder = sPath
End Function
Private Function BrowseCallback(ByVal hWnd As Long, _
  ByVal uMsg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  Select Case uMsg
    Case BFFM_INITIALIZED
      ' Start-Ordner
      Call SendMessage(hWnd, BFFM_SETSELECTION, ByVal 1&, _
        ByVal m_BrowseInitDir)
  End Select
  BrowseCallback = 0
End Function
' Hilfsfunktion für AddressOf
Private Function FuncCallback(ByVal nParam As Long) As Long
  FuncCallback = nParam
End Function

Soll im Ordnerauswahl-Dialog z.B. das Anwendungsverzeichnis Ihres Programms vorselektiert werden, rufen Sie die BrowseForFolder-Funktion wie folgt auf:

Dim sPath As String
sPath = BrowseForFolder("Bitte Ordner auswählen", App.Path)
If sPath <> "" Then
  MsgBox sPath
End If

Dieser Tipp wurde bereits 1.200 mal aufgerufen.

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2021 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel