Pfadbrowsingfunktion
11.08.2005 11:27:50
Klamsi
Ich hab ein kleines Tool vor langer Zeit geschrieben bekommen, in dem man einen Pfad wählen kann.
Das da:
funktioniert super.
Ich wähle den Ordner aus, und das Tool gibt mir den Pfad zurück.
Nur ich muss das Tool jetzt ein bissl erweitern. Weil ich brauch jetzt nicht mehr den Pfad für einen Ordner, sondern den Pfad für eine Datei. Aber wenn ich in dem Tool einen Ordner öffne, werden mir nicht die da drin enthaltenen Dateien angezeigt.
Wisst ihr wie man das erweitern kann? Weil ich check den SourceCode gar nicht aus. Is mir zu hoch. Vielleicht kennt sich damit ja einer aus, oder kennt ein anderes Tool was meinen Wünschen entspricht. Wäre geil... ^^
Hier der Quellcode, kann 1 zu 1 in ein Modul übernommen und gestartet werden:
---------------------------------------------------------------------
' Deklariert die Pfadbrowsingfunktion
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
Sub Verzeichnisse_auflisten()
Dim pfad1 As String
Dim pfad2 As String
Dim msg As String
Dim YN1 As Integer
Dim YN2 As Integer
Dim YN3 As Integer
' Pfad abfragen
Pfadabfrage:
msg = "Wählen Sie bitte den Pfad zum Filelisting aus:"
pfad1 = getdirectory(msg) 'Fürt Pfadbrowsingfunktion aus
If pfad1 = "" Then
YN1 = MsgBox("Pfadabfrage Stoppen?", vbYesNo)
If YN1 = vbYes Then End
If YN1 = vbNo Then GoTo Pfadabfrage
End If
'dem Pfadsting werden Gänsefüßchen hinzugefügt um der Shellsyntax zu entsprechen
pfad2 = """"
pfad2 = pfad2 + pfad1 + pfad2
End Sub
' Muß erwähnt sein: Diese Funktion stammt nicht von mir.
' Die Quelle ist mir nicht mehr bekannt.
'Pfadbrowsing
Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
' Ausgangsordner = Desktop
bInfo.pidlRoot = 0&
' Dialogtitel
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
' Rückgabe des Unterverzeichnisses
bInfo.ulFlags = &H1
' Dialog anzeigen
x = SHBrowseForFolder(bInfo)
' Ergebnis gliedern
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = "" 'für Fehleingabe bzw. Cancel
End If
'Bei Fehlangabe wird
Function erneut gestartet
End Function