Herbers Excel-Forum - das Archiv

FileDialog

Bild

Betrifft: FileDialog
von: Lars

Geschrieben am: 04.04.2005 22:21:34
Guten Abend,
ich benutze öfter den Filedialog, klappt auch super zur Auswahl von Dateien
nur Ordner auswählen gelingt nicht. In der Hilfe ist dzau kein Beispiel zu finden.
Kann mir jemand ein Beispiel zur Ordnerauswahl geben?
Grüße Lars
Bild

Betrifft: AW: FileDialog
von: Ramses

Geschrieben am: 04.04.2005 22:50:54
Hallo
eine einfache Variante für alle Office Versionen

Option Explicit
'############################################################################################'
' Die folgenden Makros durchsuchen einen Ordner und seine Unterordner '
' Modified by Ramses '
' Der Code besteht zu TeilFragmenten aus Forumsbeiträgen
' Die einzelnen Verfasser sind mir leider nicht mehr bekannt. '
'############################################################################################'
'############################################################################################'
'Dieser Bereich kann entfallen, wenn der Variable 'Laufwerk' ein fester Wert zugewiesen wird.'
Public 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 '
Declare
Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 
Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Msg) As String
Dim myInfo As BROWSEINFO
Dim mypath As String
Dim Root As Long, ID As Long, pos As Integer
With myInfo
.pidlRoot = 0&
.lpszTitle = Msg
.ulFlags = &H1
End With
ID = SHBrowseForFolder(myInfo)
mypath = Space$(512)
Root = SHGetPathFromIDList(ByVal ID, ByVal mypath)
If Root Then
pos = InStr(mypath, Chr$(0))
GetDirectory = Left(mypath, pos - 1)
Else
GetDirectory = ""
End If
End Function

Sub Select_Path()
Dim Msg As String, mypath As String
Msg = "Wählen Sie ein Verzeichnis aus," & Chr(13) & "dessen Inhalt angezeigt werden soll:"
mypath = GetDirectory(Msg)
If Len(mypath) > 0 Then
MsgBox "Sie haben das Verzeichnis: " & mypath & " ausgewählt"
Else
MsgBox "Nichts ausgewählt"
End If
End Sub

Und hier die Variante speziell für Office XP und höher

Sub A_Pfad_wählen()
Dim i As Integer, y As Integer, totFiles As Integer, Qe As Integer
Dim Sind As Long
Dim wks As Worksheet
Dim gefFile As String
Dim Suchbegriff As String, Suchpfad As String
Dim oldStatus As Variant
'Neue Funktion erst ab Office XP verwendbar
'bzw. auch unter 2000 wenn ein Verweis auf die Office 10 Library
'gesetzt werden kann.
'Öffnet einen Dialog indem der Pfad elegant wie im normalen
'Datei-Dialog gewählt werden kann.
Dim Suchdialog As FileDialog
Set Suchdialog = Application.FileDialog(msoFileDialogFolderPicker)
If Application.Version < 10 Then
Qe = MsgBox("Diese Datei bzw. dieser Suchdialog ist erst ab EXCEL XP möglich!", vbCritical + vbOKOnly, "Tut mir leid...")
Exit Sub
End If
Application.ScreenUpdating = False
oldStatus = Application.DisplayStatusBar
Application.DisplayStatusBar = True
'Hier wird der neue FolderPickerDialog aufgerufen
With Suchdialog
.Title = "Bitte wählen Sie ein Verzeichnis aus"
'Environ(25) ermittelt den Aktuellen Userpfad
.InitialFileName = Environ(25) & "\Eigene Dateien\"
.ButtonName = "Auswahl übernehmen"
.Show
If .SelectedItems.count = 0 Then
MsgBox "Sie haben keine Auswahl getroffen", vbInformation
Set Suchdialog = Nothing
Exit Sub
Else
For Sind = 1 To .SelectedItems.count
Suchpfad = Suchpfad & .SelectedItems(Sind) & vbCrLf
Next Sind
End If
End With
MsgBox ("Der Suchpfad den Sie gewählt haben lautet: " & Suchpfad)
End Sub


Gruss Rainer
Bild

Betrifft: AW: FileDialog
von: Lars
Geschrieben am: 04.04.2005 23:14:12
Hallo Rainer,
danke funktioniert. Wenn Folderpicker gewählt ist geht Multiselect ja nicht.
Wozu ist denn da die Schleife?
Grüße Lars
Bild

Betrifft: AW: FileDialog
von: Ramses
Geschrieben am: 04.04.2005 23:17:06
Hallo
"...Wozu ist denn da die Schleife?..."
Das musst du Billy fragen :-)
Ohne die Schleife kannst du nicht rausfinden, welcher Eintrag gewählt wurde ;-)
Gruss Rainer
Bild

Betrifft: AW: FileDialog
von: K.Rola

Geschrieben am: 04.04.2005 23:38:19
Hallo Rainer,
Option Explicit
Sub FileDialog_FolderPicker()
Dim strFolder As String
With Application.FileDialog(4)
.InitialFileName = "C:\"
.Title = "Trau dich!"
.ButtonName = "Test"
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
MsgBox strFolder
Else
MsgBox "Nix gewählt!"
End If
End With
End Sub

Gruß K.Rola

Der Fleiß ist die Wurzel aller Häßlichkeit.

Oscar Wilde


Bild

Betrifft: AW: FileDialog
von: Lars
Geschrieben am: 05.04.2005 00:18:16
Hallo K.Rola,
danke, das funktioniert gut.
Grüße Lars
Bild

Betrifft: AW: FileDialog
von: Rolf Beißner
Geschrieben am: 06.04.2005 15:51:29
Hallo K.Rola,
bei
.InitialFileName = "Desktop"
wird irgendwas angezeigt - nur kein Desktop.
Gibst du mir bitte einen Tipp, wie's geht?!
Herzliche Grüße
Rolf
Bild

Betrifft: AW: FileDialog
von: K.Rola
Geschrieben am: 06.04.2005 16:25:37
Hallo,
verwende den Code so wie gepostet und klick den Desktop an, dann hast du den
korrekten Pfad.
Gruß K.Rola
Bild

Betrifft: geht!
von: Rolf Beißner
Geschrieben am: 06.04.2005 16:54:27
vielen lieben Dank + herzliche Grüße
Rolf
Bild

Betrifft: AW: geht!
von: K.Rola
Geschrieben am: 06.04.2005 17:19:48
Hallo,
geht zwar, kann aber auf jedem PC anders sein!
Gruß K.Rola
Bild

Betrifft: AW: geht!
von: Rolf Beißner

Geschrieben am: 06.04.2005 20:30:23
Hallo K.Rola,
der PC scheint nicht die einzige Variable zu sein;
die Folderbezeichnung ist offenbar auch verfahrensabhängig:
Bei Nutzung von FileDialog komme ich z.B. mit "Arbeitsplatz" an's Ziel -
bei deiner Shell.BrowseForFolder-Funktion führt so ein Monster wie
"::{20X04XXX-3XXX-1069-X2X8-08002X30309X}" zum gleichen Ergebnis.
Nochmals danke + schönen Abend
Rolf
Bild

Betrifft: AW: geht!
von: K.Rola
Geschrieben am: 06.04.2005 21:00:36
Hallo,
oder man nutzt die API SHGetSpecialFolderLocation, dann ist es universell.
Gruß K.Rola
Bild

Betrifft: API
von: Rolf Beißner

Geschrieben am: 07.04.2005 08:38:57
Hallo K.Rola,
du hast eben immer noch einen Pfeil im Köcher!
Mit dem ganzen API-Sch... kann ich nicht viel anfangen -
ist mir zu kompliziert + zu unelegant.
Und dass die meisten Probleme mit VBA-Mitteln lösbar sind,
demonstrierst du ja ständig sehr eindrucksvoll.
Herzliche Grüße
Rolf
Bild

Betrifft: AW: API
von: K.Rola

Geschrieben am: 07.04.2005 11:33:17
Hallo,
stimmt, meist gibt es auch eine andere Möglichkeit als API:
Option Explicit
Sub Special_Folder_Desktop()
Dim strDesktop As String, objSH As Object
Set objSH = CreateObject("WScript.Shell")
strDesktop = objSH.SpecialFolders("Desktop")
MsgBox strDesktop
End Sub

Gruß K.Rola
Bild

Betrifft: Quod erat demonstrandum hG Rolf o.T.
von: Rolf Beißner

Geschrieben am: 07.04.2005 12:16:22
..
 Bild