SHBrowseForFolder mit Default Pfad
01.04.2005 14:58:38
Heiko S.
mit untenstehendem Code öffene ich den Windows Dialog zur Auswahl eines Pfades.
Läuft auch super, aber ich möchte gerne die Auswahl mit einem Default Pfad und nicht immer von Desktop aus durchführen können.
Habe mich dazu schon ein wenig im Internet umgetan und festgestellt, das scheint nicht so einfach zu sein. Denn leider ist die pidlRoot keine Stringvariable der man mal eben so einfach einen Pfad zuweisen könnte.
Hat jemand sowas schon mal realsiert und könnte mir Tipps geben, ob und wie man das unter EXCEL VBA bewerkstelligen könnte.
Danke für alle Tipps und Anregungen,
Gruß Heiko
' Benutzerdefinierte Variable und API Funktionen zur Pfadauswahl.
Private 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
Private Declare
Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare
Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare
Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)
Function Pfad_auswählen(strText As String) As String
Dim bInfo As BROWSEINFO
Dim strPath As String
Dim lngret As Long
Dim intpos As Integer
With bInfo
' Einen Default Pfad einzurichten gestaltet sich nicht so einfach, dafür sind weitere
' API Aufrufe notwendig und deswegen hier erstmal nicht weiter verfolgt. So 13.03.05
.pidlRoot = 0&
.lpszTitle = strText
.ulFlags = &H1
End With
lngret = SHBrowseForFolder(bInfo)
strPath = Space$(512)
lngret = SHGetPathFromIDList(ByVal lngret, ByVal strPath)
If lngret Then
intpos = InStr(strPath, Chr$(0))
Pfad_auswählen = Left(strPath, intpos - 1)
Else
Pfad_auswählen = vbNullString
End If
' Speicher wieder frei machen.
CoTaskMemFree lngret
End Function