Public
Function
fncGetFolder( _
Optional
ByVal
sMsg
As
String
=
"Wählen Sie ein Such-Verzeichnis"
, _
Optional
ByVal
lFlag
As
BIF_Flag = BIF_RETURNONLYFSDIRS, _
Optional
ByVal
sPath
As
String
= "x:\")
As
String
Dim
xl
As
InfoT, IDList
As
Long
, RVal
As
Long
, FolderName
As
String
s_BrowseInitDir = sPath
With
xl
.hwnd = FindWindow(
"XLMAIN"
, vbNullString)
.Root = 0
.Title = lstrcat(sMsg,
""
)
.Flags = lFlag
.FName = FuncCallback(
AddressOf
BrowseCallback)
End
With
......
Private
Function
BrowseCallback( _
ByVal
hwnd
As
Long
, _
ByVal
uMsg
As
Long
, _
ByVal
wParam
As
Long
, _
ByVal
lParam
As
Long
)
As
Long
If
uMsg = BFFM_INITIALIZED
Then
Call
SendMessage(hwnd, BFFM_SETSELECTION,
ByVal
1&,
ByVal
s_BrowseInitDir)
Call
CenterDialog(hwnd)
End
If
BrowseCallback = 0
End
Function
Private
Function
FuncCallback(
ByVal
nParam
As
Long
)
As
Long
FuncCallback = nParam
End
Function