VB/VBA通用路径选择对话框

最新推荐文章于 2023-12-19 14:52:46 发布

miaozk2006

最新推荐文章于 2023-12-19 14:52:46 发布

阅读量1.2k

点赞数

本文链接：https://blog.csdn.net/miaozk2006/article/details/82416404

版权

这段代码展示了如何在VB或VBA中使用BROWSEINFO结构和SHBrowseForFolder函数创建一个通用的文件夹选择对话框。用户可以选择一个目录，如果选择取消，返回的路径为空。示例代码包括Main子程序用于测试对话框功能。

摘要由CSDN通过智能技术生成

'MOD2
Option Explicit
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pDisplayName As String
    lpTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
' *******************************************************************
' 函数名: BrowseFolder
' 功能: 浏览及选择文件夹通用对话框
' 使用方法:（1）将mdlBrowseFolder.bas模块添加到当前工程中;
' (2）在当前工程中使用
' dim strMyPath as String
' strMyPath=BrowseFolder("请选择目录")
' 代码段进行调用，用户选择的目录将保存在strPath字符串变量下;
' (3) 如果用户选择"取消"按钮,则strPath的值为空;
' *******************************************************************

Public Function BrowseFolder(strDialogTitle As String) As String
    Dim X As Long
    Dim bi As BROWSEINFO
    Dim dwIList As Long
    Dim strPath As String
    Dim wPos As Integer

    With bi
        .hOwner = 0& 'hWndAccessApp
        .lpTitle = strDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    dwIList = SHBrowseForFolder(bi)
    strPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal strPath)

    If X Then
        wPos = InStr(strPath, Chr$(0))
        BrowseFolder = Left$(strPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If

    ' 确保返回的路径字符串的最后一个字符为"\"
    If BrowseFolder <> "" And Right$(Trim$(BrowseFolder), 1) <> "\" Then
        BrowseFolder = BrowseFolder & "\"
    End If

End Function

' 测试示例

Sub Main()

Dim strMyPath As String

strMyPath = BrowseFolder("请选择目录")

MsgBox "你选择的路径是: " & strMyPath

End Sub

摘自：网络整理