请选择 进入手机版 | 继续访问电脑版

玩酷之家

 找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 572|回复: 0

调用选取文件夹(目录)对话框

[复制链接]

92

主题

97

帖子

361

积分

中级会员

Rank: 3Rank: 3

积分
361
发表于 2018-4-28 11:17:03 | 显示全部楼层 |阅读模式
调用选取文件夹(目录)对话框,调用方法: Text1.Text = GetFolder(Me.hWnd, "请选择安装目录")

  1. 'Module
  2. Option Explicit
  3. Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (LpBrowseInfo As BROWSEINFO) As Long
  4. Private Declare Function SHGetPathFromIDlist Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  5. Private Type BROWSEINFO
  6.     hOwner As Long
  7.     pidlroot As Long
  8.     pszDisplayName As String
  9.     lpszTitle As String
  10.     ulFlags As Long
  11.     lpfn As Long
  12.     lparam As Long
  13.     iImage As Long
  14. End Type
  15. Public Function GetFolder(ByVal hWnd As Long, Optional Title As String) As String
  16.     Dim bi As BROWSEINFO
  17.     Dim pidl As Long
  18.     Dim folder As String
  19.     folder = Space(255)
  20.     With bi
  21.         If IsNumeric(hWnd) Then .hOwner = hWnd
  22.         ' .ulFlags = BIF_RETURNONLYFSDIRS
  23.         .pidlroot = 0
  24.         If Title <> "" Then
  25.             .lpszTitle = Title & Chr$(0)
  26.         Else
  27.             .lpszTitle = "请选择安装目录" & Chr$(0)
  28.         End If
  29.     End With
  30.     pidl = SHBrowseForFolder(bi)
  31.     If SHGetPathFromIDlist(ByVal pidl, ByVal folder) Then
  32.         GetFolder = Left(folder, InStr(folder, Chr$(0)) - 1)
  33.     Else
  34.         GetFolder = ""
  35.     End If
  36. End Function

复制代码


回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|手机版|小黑屋|玩酷之家 ( 鄂ICP备14012049号-1 )

GMT+8, 2018-12-12 15:33 , Processed in 0.154361 second(s), 18 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表