Hilfe zu API Funktion

Hallo,
mit den folgenden Befehlen rufe ich über eine API Funktion einen
Verzeichnisbaum auf. (Das ganze ist nicht von mir, ich habe es vor
langer Zeit mal im www gefunden).
Es funktioniert soweit ganz gut, aber ich verstehe den Code leider nicht.
Meine Frage:
Wie kann ich das Anfangsverzeichnis beeinflussen?
Momentan steht dies immer auf "Desktop" "Arbeitsplatz"
Ich denke mal in diesem Bereich wird der Startfolder festgelegt
bInfo.pidlRoot = 0&
l = SHBrowseForFolder(bInfo)
Es währe toll, wenn mir jemand helfen könnte.
Danke im Voraus
Horst
Option Explicit
'
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
Declare 

Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long

Function VerzeichnisErmitteln(Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim l As Long
bInfo.pidlRoot = 0&
l = SHBrowseForFolder(bInfo)
path = Space$(512)
If SHGetPathFromIDList(ByVal l, ByVal path) Then
VerzeichnisErmitteln = Left(path, InStr(path, Chr$(0)) - 1)
Else: VerzeichnisErmitteln = ""
End If
End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Type BROWSEINFO hWndOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpFn As Long lParam As String iImage As Long End Type Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (ByRef lpbi As BROWSEINFO) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Const WM_USER As Long = &H400 Private Const BIF_RETURNONLYFSDIRS As Long = 1 Private Const BFFM_INITIALIZED As Long = 1 Private Const BFFM_SETSELECTION As Long = (WM_USER + 102) Private Const MAX_PATH As Long = 260 Public Function GetFolderInternal(ByVal Caption As String, _ ByVal Default As String) As String Dim BI As BROWSEINFO Dim ListIdx As Long Dim Path As String With BI .lpszTitle = Caption .ulFlags = BIF_RETURNONLYFSDIRS .lpFn = MakeFktnPtr(AddressOf BrowseCallbackProc) .lParam = Default End With Path = String$(MAX_PATH + 1, vbNullChar) ListIdx = SHBrowseForFolder(BI) If SHGetPathFromIDList(ListIdx, Path) Then GetFolderInternal = Left$(Path, InStr(Path, vbNullChar) - 1) End If CoTaskMemFree ListIdx End Function Private Function BrowseCallbackProc(ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal lParam As Long, _ ByVal lpData As Long) As Long On Error Resume Next If Msg = BFFM_INITIALIZED Then SendMessage hWnd, BFFM_SETSELECTION, 1&, lpData End If End Function Private Function MakeFktnPtr(ByVal FktnPtr As Long) As Long MakeFktnPtr = FktnPtr End Function Sub Test() MsgBox GetFolderInternal("Ordner auswählen:", "C:\test") End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread