这种选择文件夹窗口该如何实现??
和CAD支持文件搜索路径窗口是一样的! http://www.mjtd.com/function/list.asp?id=368&ordertype=byletter 谢谢! http://www.mjtd.com/function/list.asp?id=368&ordertype=byletter 无效
请知道实现楼主贴图的老师请指点，谢谢 xzd716 发表于 2025-4-2 22:59
http://www.mjtd.com/function/list.asp?id=368&ordertype=byletter 无效
请知道实现楼主贴图的老师请指点 ...
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" (ByVal Pidl As LongPtr, ByVal pszPath As String) As Long
Private Type BROWSEINFO
hwndOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As LongPtr
iImage As Long
End Type
#Else
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal Pidl As Long, ByVal pszPath As String) As Long
Private Type BROWSEINFO
hwndOwner 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
#End If
'通过窗口选择文件夹
'返回字符串，如果错误或取消则返回""
Public Function SelectFolder(ByVal dePath As String) As String
Dim Bi As BROWSEINFO
Dim Pidl As Long
Dim DisplayName As String
Dim Path As String
Path = VBA.Space(260)
DisplayName = VBA.Space(260)
Bi.hwndOwner = 0' 可以设置为特定的窗口句柄，0为当前AutoCAD窗口
Bi.pidlRoot = 0 ' 从桌面开始浏览
Bi.pszDisplayName = DisplayName
Bi.lpszTitle = dePath
Bi.ulFlags = &H8007 ' BIF_RETURNONLYFSDIRS | BIF_NEWDIALOGSTYLE
Bi.lpfn = 0
Bi.lParam = 0
Pidl = SHBrowseForFolder(Bi)
If Pidl <> 0 Then
SHGetPathFromIDList Pidl, Path
SelectFolder = VBA.Left(Path, InStrRev(Path, VBA.Chr(0)) - 1)
Else
SelectFolder = ""
End If
End Function
'使用案例
Sub test1()
On Error Resume Next
Dim filepath As String
filepath = SelectFolder("选择文件夹")
If filepath <> "" Then
MsgBox "已选择：" & filepath
Else
MsgBox "未选择！"
End If
End Sub
非常感谢！
页:
[1]