怎样得到类似于“浏览”这种功能的按钮，点击后弹出文件夹选择路径？

wan_j_zhang 2001-07-21 10:43:44

我只是要得到一个文件夹的路径，而非具体的文件的绝对路径。

...全文

599 16 打赏收藏转发到动态举报

写回复

用AI写文章

16 条回复

切换为时间正序

请发表友善的回复…

发表回复

Leemaasn 2001-07-22

打赏
举报

哈哈，

playyuer 2001-07-22

打赏
举报

'我又改了改:
'也能指定 RootFolder (默认目录),能得到"文件夹路径"和"绝对路径"
'引用 Microsoft Shell Controls And Automation
Dim x As New Shell32.Shell
Dim y As Shell32.Folder
'Set y = x.BrowseForFolder(Me.hWnd, "Select Folder:", 1, "c:\")
Set y = x.BrowseForFolder(Me.hWnd, "Select Folder:", 1)
If Not y Is Nothing Then
Dim sFoldersPath As String
Dim sPath As String
sPath = y
sFoldersPath = y
Do Until y.ParentFolder Is Nothing
sFoldersPath = y.ParentFolder & "\" & sFoldersPath
If VBA.InStr(sPath, ":") = 0 Then
If Not y.ParentFolder Like "*:*" Then
sPath = y.ParentFolder & "\" & sPath
Else
sPath = VBA.Mid(y.ParentFolder, VBA.InStr(y.ParentFolder, ":") - 1, 2) & "\" & sPath
'Exit Do
End If
End If
Set y = y.ParentFolder
Loop
If VBA.Len(VBA.Trim(sPath)) > 0 Then
MsgBox "Path: " & sPath & vbCrLf & "Folder Path: " & sFoldersPath
End If
End If

qaymuic 2001-07-22

打赏
举报

在网页里只要用<input type="file">就可以。
在vb里，有两种方法，首先有一个按纽，caption="浏览",在按纽的click事件中加入代码。
代码中可使用下列两种方法之一：
1。给窗体添加commondialog控件，在代码中，commondilog1.openfile（如要显示另存为对话框，可使用commondialog1.opensave)
2,用api函数

y1g1y1 2001-07-22

打赏
举报

以下站点有源泉程序。

一般的介绍不能设定默认目录，而这个程序可以。

ygyuan.go.163.com

Chice_wxg 2001-07-22

打赏
举报

我也贴一份玩玩 ^_^

Const BIF_RETURNONLYFSDIRS = &H1

Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
Private Type BROWSEINFO
hOwner 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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Function GetDir(ByVal szCaption As String) As String
Dim bi As BROWSEINFO, idl As ITEMIDLIST, rtn As Long, pidl As Long, pos As Long, path As String
bi.hOwner = Me.hwnd
bi.lpszTitle = szCaption
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space(512)
rtn = SHGetPathFromIDList(ByVal pidl, path)
If rtn Then pos = InStr(path$, Chr$(0)): GetDir = Left(path, pos - 1)
End Function

playyuer 2001-07-22

打赏
举报

Private Sub Command1_Click()
'New:
'引用 Microsoft Shell Controls And Automation
Dim x As New Shell32.Shell
Dim y As Shell32.Folder
Set y = x.BrowseForFolder(Me.hWnd, "Select Folder:", 1)
Dim sFoldersPath As String
If Not y Is Nothing Then
Dim sPath As String
sPath = y
sFoldersPath = y
Do Until y.ParentFolder Is Nothing
sFoldersPath = y.ParentFolder & "\" & sFoldersPath
If Not y.ParentFolder Like "*:*" Then
sPath = y.ParentFolder & "\" & sPath
Else
sPath = VBA.Mid(y.ParentFolder, VBA.InStr(y.ParentFolder, ":") - 1, 2) & "\" & sPath
'Exit Do
End If
Set y = y.ParentFolder
Loop
If VBA.Len(VBA.Trim(sPath)) > 0 Then
MsgBox "Path: " & sPath & vbCrLf & "Folder Path: " & sFoldersPath
End If
End If

MonkeyLin 2001-07-22

打赏
举报

给分八

xxlroad 2001-07-22

打赏
举报

Attribute VB_Name = "Module1"
Option Explicit

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

'可见只有一个参数BROWSEINFO，这是一个类型，定义如下：
Public Type BROWSEINFO
hOwner 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

'hOwner是父窗口的hWnd
'lpszTitle是显示在该窗口上方的提示文字标题
'ulFlags是设置显示的是什么类型，这里设置为显示文件目录系统
'pidlRoot为NULL（不设置任何值的时候）表示从桌面开始显示，即显示所有磁盘，包括网上邻居……
'PidLoc是返回值，表示用户选择的目录对应的ID
'这个ID还要用SHGetPathFromIDList()API转换为对应的目录才能用

'SHGetPathFromIDList()API的申明如下：
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

'另外还要申明一些常量，用于ulFlags的设置：
Public Const BIF_RETURNONLYFSDIRS = &H1 '<---我用的是这个，显示所有磁盘……
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

xxlroad 2001-07-22

打赏
举报

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtPath
Height = 345
Left = 360
TabIndex = 1
Text = "txtPath"
Top = 975
Width = 3825
End
Begin VB.CommandButton cmdLocation
Caption = "cmdLocation"
Height = 495
Left = 1605
TabIndex = 0
Top = 1935
Width = 1380
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'程序如下:
Private Sub cmdLocation_Click()

Dim LocDir As BROWSEINFO
Dim RetVal As Boolean, PidLoc As Long
Dim Path As String
Dim Pos As Integer

LocDir.hOwner = Me.hWnd
LocDir.lpszTitle = "请选择一个目录："
LocDir.ulFlags = BIF_RETURNONLYFSDIRS
'PidLoc是一个返回值，指向用户定位的目录对应的ID，还不是目录
PidLoc = SHBrowseForFolder(LocDir)
Path = Space(512)
'用SHGetPathFromIDList()API把PidLoc对应的ID转换成对应的目录
RetVal = SHGetPathFromIDList(ByVal PidLoc, ByVal Path)
If RetVal Then
'去掉后面多余的ASCII码为0的字符
Pos = InStr(Path, Chr$(0))
'txtPath就是要求输入路径的那个文本框
txtPath = Left(Path, Pos - 1)

txtPath.SetFocus
End If

End Sub

xxlroad 2001-07-22

打赏
举报

VB程序员之家  返回首页
原有信息:
序号:17587
标题:看这里... (2千字)
发信人:smallboy
时间:2000-10-30 23:28:56
阅读次数:4
详细信息:

发信人: smallboy (猛将兄), 信区: VB
标题: Re: 黔驴技穷了，帮帮忙！
发信站: 飘渺水云间 (Thu Jun 8 01:29:38 2000), 转信

终于搞定了，哈哈！还是在程序员大本营的一个源程序里找到了。
原来这个API在Shell.dll里面，怪不得API申明浏览器里找不到。
用到SHBrowseForFolder()API打开一个选择目录的非模式窗口

SHBrowseForFolder()的申明如下：
Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

可见只有一个参数BROWSEINFO，这是一个类型，定义如下：
Public Type BROWSEINFO
hOwner 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

hOwner是父窗口的hWnd
lpszTitle是显示在该窗口上方的提示文字标题
ulFlags是设置显示的是什么类型，这里设置为显示文件目录系统
pidlRoot为NULL（不设置任何值的时候）表示从桌面开始显示，即显示所有磁盘，包括网上邻居……
PidLoc是返回值，表示用户选择的目录对应的ID
这个ID还要用SHGetPathFromIDList()API转换为对应的目录才能用

SHGetPathFromIDList()API的申明如下：
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

另外还要申明一些常量，用于ulFlags的设置：
Public Const BIF_RETURNONLYFSDIRS = &H1 <---我用的是这个，显示所有磁盘……
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

程序如下：
Private Sub cmdLocation_Click()

Dim LocDir As BROWSEINFO
Dim RetVal, PidLoc As Long
Dim Path As String
Dim Pos As Integer

LocDir.hOwner = Me.hWnd
LocDir.lpszTitle = "请选择一个目录："
LocDir.ulFlags = BIF_RETURNONLYFSDIRS
'PidLoc是一个返回值，指向用户定位的目录对应的ID，还不是目录
PidLoc = SHBrowseForFolder(LocDir)
Path = Space(512)
'用SHGetPathFromIDList()API把PidLoc对应的ID转换成对应的目录
RetVal = SHGetPathFromIDList(ByVal PidLoc, ByVal Path)
If RetVal Then
'去掉后面多余的ASCII码为0的字符
Pos = InStr(Path, Chr$(0))
'txtPath就是要求输入路径的那个文本框
txtPath = Left(Path, Pos - 1)

txtPath.SetFocus
End If

End Sub

。。。。还是比较繁琐的说，嘻嘻。不过速度很快，因为都是消息传来传去的，肯定不会慢的啦，而且效果也不错哦！
--
有空吗？到湖滨校区版(Campus_Hubin)灌水去(^o^)
哦，还有我的主页：http://10.31.3.2/boy

--------------------------------------------------------------------------------
相关信息:

在ＶＢ中使命令按钮成为＂浏览＂按钮应该如何做？？？谢谢．． (空)(迷茫昨天22:26 阅读 3)
为什么没人回答我???? (空)(迷茫昨天23:00 阅读 1)
如想偷懒,可用那个打开对话框(在一个OCX中,记不清了,好久不用了),我更洗欢建立个类模块 (空)(方舟2号昨天23:04 阅读 0)
看这里... (2千字)(smallboy 昨天23:28 阅读 4)

-----------------------------------------------------------------------

playyuer 2001-07-21

打赏
举报

'New:
'引用 Microsoft Shell Controls And Automation
Dim x As New Shell32.Shell
'MsgBox x.BrowseForFolder(Me.hWnd, "Select Folder:", 1)
x.BrowseForFolder(Me.hWnd, "Select Folder:", 1)