[原创]在浏览文件夹时指定初始目录

[ken98091]

'大家对怎样调用浏览文件夹这个API可能都会用，
'但可能对于如何指定初始目录则可能无从下手了
'以下是本人的一点心得，希望大家会用的着
'以下在窗体,因为本例用到了addressof运算符，请注意存盘
'--------------------------------------------------
'鬼龙之舞
'------------------------------------------------
Option Explicit
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 SHBrowseForFolder Lib "shell32.dll" (ByRef lpbi As BROWSEINFO) As Long
Private Const BIF_RETURNONLYFSDIRS = &H1

Private Sub FORM_Load()
Dim bi As BROWSEINFO
bi.pidlRoot = 0
bi.ulFlags = BIF_RETURNONLYFSDIRS
bi.lpfn = GetProc(AddressOf BrowseCallbackProc)
SHBrowseForFolder bi
End Sub

'以下在模块，把初始目录设为c:\windows\system
'添加模块:[工程]-[添加模块]


Option Explicit

Private Const BFFM_INITIALIZED = 1
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)

Public Function BrowseCallbackProc(ByVal hDlg As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = BFFM_INITIALIZED Then '对话框初始化时设置目录
SendMessage hDlg, BFFM_SETSELECTIONA, 1, ByVal "c:\windows\system"
End If
BrowseCallbackProc = 1
End Function
Public Function GetProc(ByVal Proc As Long) As Long
GetProc = Proc
End Function

[hkhsd]

好东西，虽然看不太懂，但能用。

[hisofty]

还有不少以bffm_开头的消息