VB怎么点击一个按纽,然后出来目录浏览的界面？

2008-03-29 05:00:20 358 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

用VB实现目录选择+浏览下面用API实现目录浏览,选择目录，如果有高手能够在选择目录时新建一个，请续，谢谢!Common.bas*************************************************************Option ExplicitPublic Type BrowseInfo hwndOwner As Long pIDLRoot As Lon 阅读详情

...全文

VB.NET 中调用浏览目录对话框 VB.NET 中调用浏览目录对话框Montaque 概述：我们都知道在.NET中调用一个打开文件的对话框很容易，定义一个OpenFileDialog类的实例就可以直接使用了。有时候我们需要让用户选择一个工作目录，或者一个系统目录，于是就在搜索是不是有类似的OpenDirectoryDialog类呢？当然最好有一个，这样就很方便了。其实系统并没有提供这么一个类阅读详情

yiqing6603058

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

cbm6666 2008-03-31

打赏
举报

Attn: 11F

'这个是用 API 的方法,是比2F的麻烦多了

'添加 Command1

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 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
Const BIF_RETURNONLYFSDIRS = &H1

Private Sub command1_Click()
Dim Browse As BROWSEINFO
Dim R&, pidl&, path$, pos%
Browse.hOwner = Me.hWnd '句柄
Browse.pidlRoot = 0& '展开根目录
Browse.lpszTitle = "请选择软件安装路径：" '列表框标题
Browse.ulFlags = BIF_RETURNONLYFSDIRS '规定只能选择文件夹，其他无效
pidl = SHBrowseForFolder(Browse) '调用API函数显示列表框
path = Space$(512) '利用API函数获取返回的路径
R = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If R Then pos = InStr(path, Chr(0)): Me.Caption = Left(path, pos - 1)
End Sub

hackerlyf 2008-03-31

打赏
举报

DefType.bas
'打开文件对话框
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

'--------------------------------------------------------

'打开文件
Public Function SelectTemplate(ByVal filter As String, ByVal ExtType As String, ByVal Title As String) As String
On Error Resume Next
Dim OFName As DefType.OPENFILENAME
With OFName
.lStructSize = Len(OFName)
' .hwndOwner = Owner
.hInstance = App.hInstance
.lpstrFile = Space$(254)
.nMaxFile = 255
.lpstrFileTitle = Space$(254)
.nMaxFileTitle = 255

.lpstrFilter = Replace(filter, "|", Chr(0)) & Chr(0)
.lpstrInitialDir = InitialDir
.lpstrTitle = Title
.flags = 8 + 2048 + 2 + 4
.lpstrDefExt = ExtType
End With

If GetOpenFileName(OFName) = 1 Then
SelectTemplate = OFName.lpstrFile
Else
SelectTemplate = ExtType
End If
End Function

'调用
Private Sub CmdSelect1_Click()
Dim FilePath As String
FilePath = SelectTemplate("*.XLS|*.XLS", "*.XLS", "选择模板文件")
End Sub

yangzn76 2008-03-31

打赏
举报

cbm666大哥的方法，其实相当于引用 shell32.dll “Mircosoft Shell controls and automation"
我今天才知道有这个对象.

舉杯邀明月 2008-03-31

打赏
举报

[Quote=引用 18 楼 shortppsy 的回复:]
离了控件，就不能写程序了？？？
[/Quote]

老兄，话不要说得那么绝嘛，难道你编写程序，你就自己先编写个开发平台再来吗？你要用电脑，就自己把所有的元件制造出来再组装吗？你需要用电，就自己建一座发电站吗？

cbm6666 2008-03-31

打赏
举报

CommonDialog是能够完成许多事, 只要你不选取消, 选到的文件是.txt就用Notepad直接打开,是.mp3或exe等就直接用explorer打开, 直接便可以听歌或运行程序啊, 哈哈哈..........

shortppsy 2008-03-31

打赏
举报

离了控件，就不能写程序了？？？

舉杯邀明月 2008-03-31

打赏
举报

　　以前用过CommonDialog 。但是发觉它只适用于打开文件。

　　我看到MS Visual Studio .NET 2003和我的一个电视播放软件都用了一个跟CommonDialog极其相似的对话框来打开文件夹，以为CommonDialog能够完成，但对它的Flag属性全部测试了之后，…………彻底失望了

舉杯邀明月 2008-03-31

打赏
举报

非常感谢CBM666大师赐教！

cbm6666 2008-03-30

打赏
举报

呵呵, 那就是VB的啊, 难道你还要用API 的 SHBrowseForFolder 才算是VB的代码??

哈哈你要的话我就贴给你, 只是我不太喜欢用这个,代码长了一点.

舉杯邀明月 2008-03-30

打赏
举报

[Quote=引用 2 楼 cbm666 的回复:]
Dim SelFolder$, spShell, spFolder, spFolderItem
Private Sub Command1_Click()
On Error GoTo errhandler
Set spShell = CreateObject("Shell.Application")
Set spFolder = spShell.BrowseForFolder(0, "选择目录夹", 0, ssfDRIVES)
Set spFolderItem = spFolder.Self
SelFolder = spFolderItem.Path
MsgBox SelFolder
errhandler:
If Err > 0 Then Exit Sub
End Sub

'吃饭去…
[/Quote]

想请问这位大师:

　　有没有可以用在VB中的，能完成类似功能的控件？

forbearORfolie 2008-03-29

打赏
举报

呵呵，莫依是女生滴

cbm6666 2008-03-29

打赏
举报

Command1 与 Command2 摆一起,会产生小臭虫, 当然正常情况不会两者一起用

请在 Command1 的 With CommonDialog1里面加上

.Flags = cdlOFNExplorer

cbm6666 2008-03-29

打赏
举报

'呵要选择文件, 那你就该用 CommonDialog

'添加 CommonDialog1 Command1 Command2

'为免于你再问多个文件 "复式选择" 我特地多加了 Command2

Dim i&, aa$, SelFile$()
Private Sub Command1_Click()
On Error GoTo errhandler
With CommonDialog1
.CancelError = True
.InitDir = App.Path
.Filter = "执行文件(*.exe)|*.exe"
.ShowOpen
End With
aa = CommonDialog1.FileName
MsgBox aa
errhandler:
If Err > 0 Then Exit Sub
End Sub

Private Sub Command2_Click()
On Error GoTo errhandler
With CommonDialog1
.CancelError = True
.InitDir = App.Path
.Filter = "执行文件(*.exe)|*.exe"
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
.ShowOpen
End With
SelFile = Split(CommonDialog1.FileName, Chr(0))
Me.Cls
If UBound(SelFile) = 0 Then Print SelFile(0): Exit Sub
For i = 1 To UBound(SelFile)
Print SelFile(i)
Next i
errhandler:
If Err > 0 Then Exit Sub
End Sub

yiqing6603058 2008-03-29

打赏
举报

看不大懂 - -

yiqing6603058 2008-03-29

打赏
举报

前2个代码超长的大哥, 做这样的一个浏览目录的代码用得着那么多代码吗？
我以前是学JAVA的刚学VB 做简单点好吗方便的话加上注释好好吗？

yiqing6603058 2008-03-29

打赏
举报

不好意思 cbm666 你说的几乎完美了

只是我想做的是 , 浏览目录的同时并且能选择文件, 还有文件的类型必须是exe 文件

daisy8675 2008-03-29

打赏
举报

Private Function Browse(csidl As Long, BIF_FLAGS As Long, sTitle As String) As String



  Dim pidl As Long

  Dim bi As BROWSEINFO

  Dim sPath As String

  Dim pos As Integer

  

  'Fill BROWSEINFO structure data

   With bi

      .hOwner = Me.hWnd

      .pidlRoot = CSIDLToPIDL(csidl)

      .lpszTitle = "Browsing " & sTitle

      .ulFlags = BIF_FLAGS

      .pszDisplayName = Space$(MAX_PATH)

   End With

  

  'show dialog returning pidl to selected item

   pidl = SHBrowseForFolder(bi)

 

  'if pidl is valid, parse & return the user's selection

   sPath = Space$(MAX_PATH)

    

   If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then

   

     'SHGetPathFromIDList returns the absolute

     'path to the selected item

      pos = InStr(sPath, Chr$(0))

      If pos > 0 Then Browse = Left(sPath, pos - 1)



   End If



  'pszDisplayName contains the string

  'representing the users last selection.

  'Even when SHGetPathFromIDList is empty,

  'this should return the selection, making

  'it the choice for obtaining user information

  'when selecting Printers, Control Panel etc,

  'or any of the other virtual folders that

  'do not normally return a path

   pos = InStr(bi.pszDisplayName, Chr$(0))

   If pos > 0 Then

      Text3.Text = Left(bi.pszDisplayName, pos - 1)

   Else

      Text3.Text = ""

   End If

   

  'free the pidl

   Call CoTaskMemFree(pidl)

        

End Function





Private Function CSIDLToPIDL(ByVal csidl As Long) As Long



  Dim pidl As Long



  If csidl > 0 Then

      If SHGetSpecialFolderLocation(Me.hWnd, csidl, pidl) = S_OK Then

         CSIDLToPIDL = pidl

      End If

   Else

      CSIDLToPIDL = 0&

   End If

End Function





Private Function IsWinXPPlus() As Boolean



  'returns True if running Windows XP or later

   Dim osv As OSVERSIONINFO



   osv.OSVSize = Len(osv)



   If GetVersionEx(osv) = 1 Then

   

      IsWinXPPlus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _

                    (osv.dwVerMajor >= 5 And osv.dwVerMinor >= 1)



   End If



End Function





Private Sub LoadCombo()



   With Combo1



      .AddItem "Desktop (default browse)":

      .ItemData(.NewIndex) = CSIDL_DESKTOP



      .AddItem "Internet Explorer (icon on desktop)"

      .ItemData(.NewIndex) = CSIDL_INTERNET



      .AddItem "Start Menu\Programs"

      .ItemData(.NewIndex) = CSIDL_PROGRAMS



      .AddItem "Control Panel"

      .ItemData(.NewIndex) = CSIDL_CONTROLS



      .AddItem "Printers"

      .ItemData(.NewIndex) = CSIDL_PRINTERS



      .AddItem "My Documents"

      .ItemData(.NewIndex) = CSIDL_PERSONAL



      .AddItem "Favorites (Current User)"

      .ItemData(.NewIndex) = CSIDL_FAVORITES



      .AddItem "Start Menu\Programs\Startup"

      .ItemData(.NewIndex) = CSIDL_STARTUP



      .AddItem "Recent (Current User)"

      .ItemData(.NewIndex) = CSIDL_RECENT



      .AddItem "SendTo (Current User)"

      .ItemData(.NewIndex) = CSIDL_SENDTO



      .AddItem "Recycle Bin (desktop)"

      .ItemData(.NewIndex) = CSIDL_BITBUCKET



      .AddItem "Start Menu (Current User)"

      .ItemData(.NewIndex) = CSIDL_STARTMENU



      .AddItem "WinXP+ : Logical My Documents desktop icon"

      .ItemData(.NewIndex) = CSIDL_MYDOCUMENTS

      

      .AddItem "WinXP+ : My Music folder"

      .ItemData(.NewIndex) = CSIDL_MYMUSIC

      

      .AddItem "WinXP+ : My Videos folder"

      .ItemData(.NewIndex) = CSIDL_MYVIDEO

          

      .AddItem "Desktop Directory (Current User)"

      .ItemData(.NewIndex) = CSIDL_DESKTOPDIRECTORY



      .AddItem "My Computer"

      .ItemData(.NewIndex) = CSIDL_DRIVES



      .AddItem "Network Neighborhood"

      .ItemData(.NewIndex) = CSIDL_NETWORK



      .AddItem "NetHood (Current User)"

      .ItemData(.NewIndex) = CSIDL_NETHOOD



      .AddItem "Fonts"

      .ItemData(.NewIndex) = CSIDL_FONTS



      .AddItem "Templates"

      .ItemData(.NewIndex) = CSIDL_TEMPLATES

      

      .AddItem "Start Menu (All Users) (NT or later)"

      .ItemData(.NewIndex) = CSIDL_COMMON_STARTMENU



      .AddItem "Programs (All Users) (NT or later)"

      .ItemData(.NewIndex) = CSIDL_COMMON_PROGRAMS



      .AddItem "Startup (All Users) (NT or later)"

      .ItemData(.NewIndex) = CSIDL_COMMON_STARTUP



      .AddItem "Desktop Directory (All Users)"

      .ItemData(.NewIndex) = CSIDL_COMMON_DESKTOPDIRECTORY



      .AddItem "Application Data (Current User)"

      .ItemData(.NewIndex) = CSIDL_APPDATA



      .AddItem "PrintHood (Current User)"

      .ItemData(.NewIndex) = CSIDL_PRINTHOOD



      .AddItem "Win2k+ : Application Data (Current User, non roaming)"

      .ItemData(.NewIndex) = CSIDL_LOCAL_APPDATA



      .AddItem "Non-localized Startup"

      .ItemData(.NewIndex) = CSIDL_ALTSTARTUP



      .AddItem "Non-localized Common Startup (NT or later)"

      .ItemData(.NewIndex) = CSIDL_COMMON_ALTSTARTUP



      .AddItem "Common Favorites"

      .ItemData(.NewIndex) = CSIDL_COMMON_FAVORITES



      .AddItem "Internet Cache"

      .ItemData(.NewIndex) = CSIDL_INTERNET_CACHE



      .AddItem "Internet Cookies"

      .ItemData(.NewIndex) = CSIDL_COOKIES



      .AddItem "Internet History"

      .ItemData(.NewIndex) = CSIDL_HISTORY



      .AddItem "Win2k+ : Application Data (All Users)"

      .ItemData(.NewIndex) = CSIDL_COMMON_APPDATA



      .AddItem "Win2k+ : Windows Directory"

      .ItemData(.NewIndex) = CSIDL_WINDOWS



      .AddItem "Win2k+ : System Directory"

      .ItemData(.NewIndex) = CSIDL_SYSTEM



      .AddItem "Win2k+ : Program Files"

      .ItemData(.NewIndex) = CSIDL_PROGRAM_FILES



      .AddItem "Win2k+ : My Pictures"

      .ItemData(.NewIndex) = CSIDL_MYPICTURES



      .AddItem "Win2k+ : User Profile (Current User)"

      .ItemData(.NewIndex) = CSIDL_PROFILE



      .AddItem "Win2k+ : Program Files\Common (NT or later)"

      .ItemData(.NewIndex) = CSIDL_PROGRAM_FILES_COMMON



     .AddItem "Templates (All Users) (NT or later)"

     .ItemData(.NewIndex) = CSIDL_COMMON_TEMPLATES



     .AddItem "Documents (All Users) (NT or later)"

     .ItemData(.NewIndex) = CSIDL_COMMON_DOCUMENTS



     .AddItem "Win2k+ : Administrative Tools (All Users)"

     .ItemData(.NewIndex) = CSIDL_COMMON_ADMINTOOLS



     .AddItem "Win2k+ : Administrative Tools (Current User)"

     .ItemData(.NewIndex) = CSIDL_ADMINTOOLS

     

     .AddItem "WinXP+ : Network and Dial-up Connections"

     .ItemData(.NewIndex) = CSIDL_CONNECTIONS

     

     .AddItem "WinXP+ : (shared music) All Users\My Music"

     .ItemData(.NewIndex) = CSIDL_COMMON_MUSIC

     

     .AddItem "WinXP+ : (shared pictures) All Users\My Pictures"

     .ItemData(.NewIndex) = CSIDL_COMMON_PICTURES

     

     .AddItem "WinXP+ : (shared video) All Users\My Video"

     .ItemData(.NewIndex) = CSIDL_COMMON_VIDEO

     

     .AddItem "WinXP+ : Resource Directory (themes parent folder)"

     .ItemData(.NewIndex) = CSIDL_RESOURCES

     

     .AddItem "WinXP+ : Localized Resource Directory"

     .ItemData(.NewIndex) = CSIDL_RESOURCES_LOCALIZED



     .AddItem "WinXP+ : Links to All Users OEM specific apps"

     .ItemData(.NewIndex) = CSIDL_COMMON_OEM_LINKS

     

     .AddItem "WinXP+ : CD Burning (USERPROFILE\Local Settings\Application Data\Microsoft\)"

     .ItemData(.NewIndex) = CSIDL_CDBURN_AREA

     

     .AddItem "WinXP+ : Computers Near Me (computered from Workgroup membership)"

     .ItemData(.NewIndex) = CSIDL_COMPUTERSNEARME

   

     .ListIndex = 3  'desktop (default browse)



   End With



End Sub

daisy8675 2008-03-29

打赏
举报

使用SHBrowseForFolder 这个API，请参考：

Private Const VER_PLATFORM_WIN32_NT As Long = 2

Private Const S_OK  As Long = 0

Private Const MAX_PATH As Long = 260



'BROWSEINFO.ulFlags values

Private Const BIF_RETURNONLYFSDIRS   As Long = &H1 'only file system directories

Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2  'no network folders below domain level

Private Const BIF_STATUSTEXT As Long = &H4         'include status area for callback

Private Const BIF_RETURNFSANCESTORS As Long = &H8  'only return file system ancestors

Private Const BIF_EDITBOX As Long = &H10           'add edit box 

Private Const BIF_NEWDIALOGSTYLE As Long = &H40    'use the new dialog layout

Private Const BIF_UAHINT As Long = &H100

Private Const BIF_NONEWFOLDERBUTTON As Long = &H200 'hide new folder button

Private Const BIF_NOTRANSLATETARGETS As Long = &H400 'return lnk file

Private Const BIF_USENEWUI As Long = BIF_NEWDIALOGSTYLE Or BIF_EDITBOX

Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000 'only return computers

Private Const BIF_BROWSEFORPRINTER As Long = &H2000 'only return printers

Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000 'browse for everything

Private Const BIF_SHAREABLE As Long = &H8000 'sharable resources, requires BIF_USENEWUI



'class ID values

Private Const CSIDL_DESKTOP As Long = &H0

Private Const CSIDL_INTERNET As Long = &H1

Private Const CSIDL_PROGRAMS As Long = &H2

Private Const CSIDL_CONTROLS As Long = &H3

Private Const CSIDL_PRINTERS As Long = &H4

Private Const CSIDL_PERSONAL As Long = &H5

Private Const CSIDL_FAVORITES As Long = &H6

Private Const CSIDL_STARTUP As Long = &H7

Private Const CSIDL_RECENT As Long = &H8

Private Const CSIDL_SENDTO As Long = &H9

Private Const CSIDL_BITBUCKET As Long = &HA

Private Const CSIDL_STARTMENU As Long = &HB

Private Const CSIDL_MYDOCUMENTS As Long = &HC

Private Const CSIDL_MYMUSIC As Long = &HD

Private Const CSIDL_MYVIDEO As Long = &HE

Private Const CSIDL_UNUSED1 As Long = &HF '&HF not currently implemented

Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10

Private Const CSIDL_DRIVES As Long = &H11

Private Const CSIDL_NETWORK As Long = &H12

Private Const CSIDL_NETHOOD As Long = &H13

Private Const CSIDL_FONTS As Long = &H14

Private Const CSIDL_TEMPLATES As Long = &H15

Private Const CSIDL_COMMON_STARTMENU As Long = &H16

Private Const CSIDL_COMMON_PROGRAMS As Long = &H17

Private Const CSIDL_COMMON_STARTUP As Long = &H18

Private Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19

Private Const CSIDL_APPDATA As Long = &H1A

Private Const CSIDL_PRINTHOOD As Long = &H1B

Private Const CSIDL_LOCAL_APPDATA As Long = &H1C

Private Const CSIDL_ALTSTARTUP As Long = &H1D

Private Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E

Private Const CSIDL_COMMON_FAVORITES As Long = &H1F

Private Const CSIDL_INTERNET_CACHE As Long = &H20

Private Const CSIDL_COOKIES As Long = &H21

Private Const CSIDL_HISTORY As Long = &H22

Private Const CSIDL_COMMON_APPDATA As Long = &H23

Private Const CSIDL_WINDOWS As Long = &H24

Private Const CSIDL_SYSTEM As Long = &H25

Private Const CSIDL_PROGRAM_FILES As Long = &H26

Private Const CSIDL_MYPICTURES As Long = &H27

Private Const CSIDL_PROFILE As Long = &H28

Private Const CSIDL_SYSTEMX86 As Long = &H29 'RISC only

Private Const CSIDL_PROGRAM_FILESX86 As Long = &H2A 'RISC only

Private Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B

Private Const CSIDL_PROGRAM_FILES_COMMONX86 As Long = &H2C 'RISC only

Private Const CSIDL_COMMON_TEMPLATES As Long = &H2D

Private Const CSIDL_COMMON_DOCUMENTS As Long = &H2E

Private Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F

Private Const CSIDL_ADMINTOOLS As Long = &H30

Private Const CSIDL_CONNECTIONS As Long = &H31

Private Const CSIDL_COMMON_MUSIC As Long = &H35

Private Const CSIDL_COMMON_PICTURES As Long = &H36

Private Const CSIDL_COMMON_VIDEO As Long = &H37

Private Const CSIDL_RESOURCES As Long = &H38

Private Const CSIDL_RESOURCES_LOCALIZED As Long = &H39

Private Const CSIDL_COMMON_OEM_LINKS As Long = &H3A

Private Const CSIDL_CDBURN_AREA As Long = &H3B

Private Const CSIDL_UNUSED2 As Long = &H3C '&H3C not currently implemented

Private Const CSIDL_COMPUTERSNEARME As Long = &H3D



'special flags

Private Const CSIDL_FLAG_PER_USER_INIT As Long = &H800 

Private Const CSIDL_FLAG_NO_ALIAS As Long = &H1000 

Private Const CSIDL_FLAG_DONT_VERIFY As Long = &H4000 

Private Const CSIDL_FLAG_CREATE As Long = &H8000 

Private Const CSIDL_FLAG_MASK As Long = &HFF00 



'windows-defined type OSVERSIONINFO

Private Type OSVERSIONINFO

  OSVSize         As Long

  dwVerMajor      As Long

  dwVerMinor      As Long

  dwBuildNumber   As Long

  PlatformID      As Long

  szCSDVersion    As String * 128

End Type



'parameters for SHBrowseForFolder

Private Type BROWSEINFO    'BI

    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 Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _

  (ByVal hwndOwner As Long, _

   ByVal nFolder As Long, _

   pidl As Long) As Long



Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _

  (lpVersionInformation As OSVERSIONINFO) As Long



Private Declare Sub CoTaskMemFree Lib "ole32.dll" _

  (ByVal pv As Long)







Private Sub Form_Load()

   

   Command1.Caption = "Browse"

   

   Check1.Caption = "Include files as well as folders in dialog"

   Check2.Caption = "Use new dialog style (resizable w/new folder button)"

   

   Check3.Caption = "Include edit box"

   Check4.Caption = "Use UA Hint (edit box overrides)"

   

   Check5.Caption = "Hide the New Folder button"

   Check6.Caption = "Return shortcut; don't traverse to file ( XP or later )"

   

   Text1.Text = ""

   Text2.Text = ""

   Text3.Text = ""

   Text4.Text = ""

   

   Check2_Click

   

   Check6.Enabled = IsWinXPPlus()

   

   Call LoadCombo

   

End Sub





Private Sub Command1_Click()



   Dim dwFlags As Long

   Dim sTitle As String

   Dim csidl As Long

   

   

  'build dwFlags according to the options selected

   If Check1.Value = vbChecked Then dwFlags = dwFlags Or BIF_BROWSEINCLUDEFILES

   If Check2.Value = vbChecked Then dwFlags = dwFlags Or BIF_NEWDIALOGSTYLE

   If Check3.Value = vbChecked Then dwFlags = dwFlags Or BIF_EDITBOX

   If Check4.Value = vbChecked Then dwFlags = dwFlags Or BIF_UAHINT

   If Check5.Value = vbChecked Then dwFlags = dwFlags Or BIF_NONEWFOLDERBUTTON

   If Check6.Value = vbChecked Then dwFlags = dwFlags Or BIF_NOTRANSLATETARGETS

  

   sTitle = Combo1.List(Combo1.ListIndex)

   csidl = Combo1.ItemData(Combo1.ListIndex)

   

   Text4.Text = Browse(csidl, dwFlags, sTitle)

   

End Sub





Private Sub Combo1_Click()



   Dim csidl As Long

   csidl = Combo1.ItemData(Combo1.ListIndex)

   Text1.Text = csidl

   Text2.Text = "&H" & CStr(Hex(csidl))

   

End Sub





Private Sub Check2_Click()



   Check3.Enabled = Check2.Value = vbChecked

   Check4.Enabled = Check2.Value = vbChecked

   Check5.Enabled = Check2.Value = vbChecked



End Sub

cbm6666 2008-03-29

打赏
举报

Dim SelFolder$, spShell, spFolder, spFolderItem
Private Sub Command1_Click()
On Error GoTo errhandler
Set spShell = CreateObject("Shell.Application")
Set spFolder = spShell.BrowseForFolder(0, "选择目录夹", 0, ssfDRIVES)
Set spFolderItem = spFolder.Self
SelFolder = spFolderItem.Path
MsgBox SelFolder
errhandler:
If Err > 0 Then Exit Sub
End Sub

'吃饭去啦..............

杨哥儿 2008-03-29

打赏
举报

是文件目录,还是标题?没说清...

VB怎么点击一个按纽,然后出来目录浏览的界面？

相关推荐