alle Unterordner anzeigen

Forumthread: alle Unterordner anzeigen

06.10.2004 09:58:59

Remo

Hallo Leute
Ich möchte mir alle Unterordner des Ordner C:\Daten anzeigen lassen.
Weiss jemand wie's funktioniert?
Habs schon mit Application.filesearch probiert, dies scheint aber nur für Dateien zu sein.
Freue mich auf eure Antworten
Gruss Remo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: alle Unterordner anzeigen

06.10.2004 10:48:21

Hajo_Zi

Hallo Remo
'Ab XL2002 / Xp:


Sub VerzAuswahl()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then
MsgBox fd.SelectedItems(1)
End If
End Sub

'von Frank Arendt-Theilen (NG)
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Pro SP2 und Excel Version 2003

AW: alle Unterordner anzeigen

Remo

Danke für die Hilfe.
Meine Version Application.Filedialog leider noch nicht.
Gruss Remo

AW: alle Unterordner anzeigen

06.10.2004 11:22:44

Hajo

Hallo Remo,
ich habe mich da an die angegeben Version gehalten.
Option Explicit
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
'32-bit API-Deklarationen
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

Sub VerzeichnisauswahlStarten()
Dim strMessage As String
strMessage = "Wählen Sie bitte einen Ordner aus:"
MsgBox GetDirectory(strMessage)
End Sub



Function GetDirectory(Optional strMessage) As String
Dim bInfo As BROWSEINFO
Dim strPath As String
Dim lngR As Long, lngX As Long, intPos As Integer
'  Ausgangsordner = Desktop
bInfo.pidlRoot = 0&
'  Dialogtitel
If IsMissing(strMessage) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = strMessage
End If
'  Rückgabe des Unterverzeichnisses
bInfo.ulFlags = &H1
'  Dialog anzeigen
lngX = SHBrowseForFolder(bInfo)
'  Ergebnis gliedern
strPath = Space$(512)
lngR = SHGetPathFromIDList(ByVal lngX, ByVal strPath)
If lngR Then
intPos = InStr(strPath, Chr$(0))
GetDirectory = Left(strPath, intPos - 1)
Else
GetDirectory = ""
End If
End Function


Bitte keine Mail, Probleme sollten im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

Betriebssystem XP Pro SP2 und Excel Version 2003

Habe meinen Meister gefunden :-) o.T.

Remo

Beliebteste Forumthreads (12 Monate)

Forumthread: alle Unterordner anzeigen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread