Hilfe zu API Funktion

Forumthread: Hilfe zu API Funktion

04.07.2006 07:56:00

Horst

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

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Hilfe zu API Funktion

04.07.2006 08:02:43

Matthias
AW: Hilfe zu API Funktion

04.07.2006 08:39:50

Horst

AW: Hilfe zu API Funktion

04.07.2006 08:02:43

Matthias

Hallo Horst,
folgender Code ist auch nicht von mir, ich kann ihn auch nicht erklären, aber die Vorauswahl funktioniert:


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

Gruß Matthias

AW: Hilfe zu API Funktion

04.07.2006 08:39:50

Horst

Hallo Mathias,
super, es funktioniert. Vielen Dank.
Wenn ich mal Zeit habe vergleiche ich mal die beiden Listings.
Eventuell kann ich ja was lernen.
Gruß Horst

Beliebteste Forumthreads (12 Monate)

Forumthread: Hilfe zu API Funktion

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread