Option Compare Database
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1 Private Const BIF_DONTGOBELOWDOMAIN = 2 Private Const MAX_PATH = 260
Private Type BrowseInfo hwndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Function OpenDirectoryTV(Optional odtvTitle As String) As String
Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim tBrowseInfo As BrowseInfo szTitle = odtvTitle lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) OpenDirectoryTV = sBuffer End If End Function
Private Sub Command0_Click() Me.Text1 = OpenDirectoryTV("请选择一个目录") End Sub
|