'=======================================
'打开文件夹
'=======================================
Public Function GetDirName() As String
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
bi.pidlRoot = 0&
bi.lpszTitle = srtTitle
bi.ulFlags = 1
pidl = SHBrowseForFolder(bi)
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirName = Left(path, pos - 1)
Else: GetDirName = ""
End If
End Function
'打开文件夹
'=======================================
Public Function GetDirName() As String
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
bi.pidlRoot = 0&
bi.lpszTitle = srtTitle
bi.ulFlags = 1
pidl = SHBrowseForFolder(bi)
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirName = Left(path, pos - 1)
Else: GetDirName = ""
End If
End Function
解决方案 »
- 可不可能在电脑关机的时候,记录下来都哪些文件被打开了??
- 关于数据库查询记录集
- 大家帮帮忙!急用
- ★杭州的大吓请进来一下,我现在在武汉,工作经验一年,一家杭州的公司叫我过去,试用期1500,什么都不管,我不知道在哪边1500能不能养活
- 如何动态生成EXE
- 请问那边有vb6帮助文档.chm
- 怎么给控件MSFlexGrid和dbgrid控件的每行换一种颜色?
- VB中FORM的最大长宽是怎么确定的啊,我想要做得更大一些可以吗?
- 一个好好玩的问题,大家来回答呀,分很高的
- 请问水晶报表那里有下载,还有那里有它的使用方法
- 真的很急,一个星期能学会ASP么?散分!!
- 我要做个小东西。可以(1分钟)不停地ping 一个ip,当ping 不通的时候。就发出声音。。
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As LongPrivate 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
先引用:Microsoft Shell Controls And AutomationPrivate m_Shell As New Shell
Private m_fldShellFolder As Folder 'Shell Browse For FolderPrivate Sub Command1_Click()
'选择文件夹
Set m_fldShellFolder = m_Shell.BrowseForFolder(Me.hWnd, "请选择文件夹:", 1)
With m_fldShellFolder.Items.Item
MsgBox .Path
MsgBox "Name: " & .Name & vbCrLf & _
"Type: " & .Type & vbCrLf & _
"Last Modified: " & .ModifyDate & vbCrLf & _
"Parent: " & .Parent & vbCrLf
End WithEnd Sub
' form 中
'程序如下:
Private Sub cmdLocation_Click() '为 command
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.Text = Left(Path, Pos - 1) txtPath.SetFocus
End If
End Sub' bas 中
Option ExplicitPublic 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