Ordnerauswahl mit Pfad

Sub ShellTest() Dim objS As Shell Dim objFo As Folder Set objS = New Shell With objS Set objFo = .BrowseForFolder(0&, "Wählen Sie einen Ordner...", 0, 12) End With On Error Resume Next MsgBox "Gewählt wurde: " & objFo.Title End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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 Bye Nike

Na wenn das stimmt, würde es mich jetzt doch etwas trösten - so als Hobbyprogrammierer ;o) Damit unser Beitrag auch alles etwas bringt, hier noch einmal der Code im Ganzen:
Dieser Code öffnet eine Windows-Auswahlbox, mit welcher ein beliebiger ORDNER/FOLDER spezifiziert werden kann. Als Rückgabewert erhält man den kompletten Pfad der Auswahl. Nike & PT wünschen allen Usern weiterhin viel Erfolg.
'------------------------------------------------------------------------------------
Public Type BROWSEINFO
'Code zum Auswählen eines Ordners - der Pfad wird gespeichert
'Benutzerdefinierter Typ, gilt Modulweit und wird
'fuer die Funktion getdirectory benoetigt
'ACHTUNG: Diese Declaration muß immer im Kopfbereich des Moduls stehen
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 DirAuswahl()
xDIR = getdirectory()
MsgBox ("Der Ordner war: " & xDIR)
End Sub



Function getdirectory(Optional msg) As String
'Funktion um ein Verzeichnis von Benutzer angeben zu lassen.
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1) & "\"
Else
getdirectory = ""
End If
End Function


'----------------------------------------------------------------------------------

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread