2
www.ChF-Online.de  

Ein beliebiges Verzeichnis öffnen

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
aktiv aktiv Verschiedenes
 Dateiname ohne Endung
 Dokumentstrukturanzeige
 Fenster anordnen
 Fensterliste
 Fensterliste (II)
 Kalender erstellen
 Kommentarinformationen
 Lesezeichen
aktiv  Beliebigen Ordner öffnen
 Position der Einfügemarke
 Seitenanfang/-ende
 Shapes ansprechen
 Sicherheitskopien erstellen
 Word-Startparameter
 Word-Startparameter II
 Startordner "Bild einfügen"
 Tags finden u. bearbeiten
 Tags finden/bearbeiten (II)
 Text2WordArt
 Textbausteine verwenden
 Textmarken (I)
 Textmarken (II)
 Überschrift zu Textmarke
 VBA-Konverter
 Wasserzeichen
 Zeichen tauschen
 Feld-Arbeiten
 Form-Sachen
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Getestet unter Word2000Getestet unter WordXPGetestet unter Win2000  
Print

Mit den integrierten Dialog-Fenstern (Dialogs(...) lassen sich bequem Dateien einlesen und daraus der Dateiname und der Pfad ermitteln. Soll hingegen nur ein Verzeichnis(name) ermittelt oder ausgewählt werden, ist der Weg über die Dateiauswahl nicht die eleganteste.
An dieser Stelle kann auf den API-Aufruf SHBrowseForFolder zurückgegriffen werden. Mit Hilfe dieses API erhält man ein Dialog-Fenster mit den verfügbaren Verzeichnisbäumen.
Das ausgewählte Verzeichnis kann an eine Variable zurückgegeben und weiter verwendet werden. Dem Aufruf kann auch ein Verzeichnis als Startverzeichnis mitgegeben werden. Im folgenden Beispiel wird der evtl. bereits zurückgegebene Verzeichnisname wieder als Startverzeichnis für den nächsten Aufruf verwendet. Zu beachten ist dabei nur, daß die Variable nur solange zur Verfügung steht, wie die Funktion aktiv ist.
Erfolgt der Aufruf aus einer Userform heraus, bleibt die Variable für die Dauer der Anzeige der Userform gültig. Wird der Aufruf als Funktion in eine Symbolleiste eingefügt, läßt sich das letzte Verzeichnis z.B. in die .Tag-Eigenschaft speichern.

1    Sub Ordnerauswahl()
2    Dim Verzeichnis As String 
3    Verzeichnis2 = GetFolderInternal(Verzeichnis, Verzeichnis)
4    End Sub 

Und in ein extra Modul:

1      Option Explicit 
2       Private Type BROWSEINFO
3          hWndOwner As Long 
4          pidlRoot As Long 
5          pszDisplayName As String 
6          lpszTitle As String 
7          ulFlags As Long 
8          lpFn As Long 
9          lParam As String 
10         iImage As Long 
11      End Type 
12      Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
         Alias "SHBrowseForFolderA" (ByRef lpbi As BROWSEINFO) As Long 
13      Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
         Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
         ByVal pszPath As String) As Long 
14      Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
15      Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
         (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
         ByVal lParam As Long) As Long 
16      Private Const WM_USER As Long = &H400
17      Private Const BIF_RETURNONLYFSDIRS As Long = 1
18      Private Const BFFM_INITIALIZED As Long = 1
19      Private Const BFFM_SETSELECTION As Long = (WM_USER + 102)
20      Private Const MAX_PATH As Long = 260
21      Public Function GetFolderInternal(ByVal Caption As String, _
         ByVal Default As String) As String 
22         Dim BI As BROWSEINFO
23         Dim ListIdx As Long 
24         Dim Path As String 
25         With BI
26            .lpszTitle = Caption
27            .ulFlags = BIF_RETURNONLYFSDIRS
28            .lpFn = MakeFktnPtr(AddressOf BrowseCallbackProc)
29            .lParam = Default 
30         End With 
31         Path = String$(MAX_PATH + 1, vbNullChar)
32         ListIdx = SHBrowseForFolder(BI)
33         If SHGetPathFromIDList(ListIdx, Path) Then 
34            GetFolderInternal = Left$(Path, InStr(Path, vbNullChar) - 1)
35         End If 
36         CoTaskMemFree ListIdx
37      End Function 
38      Private Function BrowseCallbackProc(ByVal hWnd As Long, _
         ByVal Msg As Long, _
         ByVal lParam As Long, _
         ByVal lpData As Long) As Long 
39         On Error Resume Next 
40         If Msg = BFFM_INITIALIZED Then 
41            SendMessage hWnd, BFFM_SETSELECTION, 1&, lpData
42         End If 
43      End Function 
44      Private Function MakeFktnPtr(ByVal FktnPtr As Long) As Long 
45         MakeFktnPtr = FktnPtr
46      End Function 

Der Dateidownload steht z.Z. leider nicht zur Verfügung.


 Besucher: 2 online  |  79 heute  |  2679 diesen Monat  |  1593928 insgesamt | Seitenaufrufe: 78   Letzte Änderung: 24.06.2006 © 2001-14 Christian Freßdorf
  EDV-Systeme verarbeiten, womit sie gefüttert werden. Kommt Mist rein, kommt Mist raus.
A. Kostolany
 powered by phpCMS and PAX