''''下面用API实现目录浏览,选择目录,如果有高手能够在选择目录时新建一个,请续,谢谢!
''''Common.bas*************************************************************
Option Explicit
Public 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
Public Const BIF_RETURNONLYFSDIRS = 1 Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String ''''定义变量 Dim iNull As Integer Dim lpIDList As Long Dim lResult As Long Dim sPath As String Dim udtBI As BrowseInfo
''''初始化..... With udtBI .hwndOwner = hwndOwner .lpszTitle = lstrcat(sPrompt, "") .ulFlags = BIF_RETURNONLYFSDIRS End With
''''调用API lpIDList = SHBrowseForFolder(udtBI) ''''得到返回结果 If lpIDList Then sPath = String$(MAX_PATH, 0) lResult = SHGetPathFromIDList(lpIDList, sPath) Call CoTaskMemFree(lpIDList) iNull = InStr(sPath, vbNullChar) If iNull Then sPath = Left$(sPath, iNull - 1) End If BrowseForFolder = sPath
End Function
''''**************************************************************************
下面在窗体中的按钮中调用
Private Sub cmdBrowse_Click() Dim strResFolder As String
strResFolder = BrowseForFolder(hWnd, "请选择一个目录.")
If strResFolder = "" Then Call MsgBox("你取消了选择目录..", vbExclamation) Else Call MsgBox("目录" & strResFolder & "被选择!", vbExclamation) End If
End Sub
没有相关教程
|