利用什么控件打开“文件夹“而不是文件--在线等待！

Question

就像CommonDialog可以打开文件一样，打开文件夹！功能类似DriveListBox,多谢了！

Answer 1

CommonDialog不行吗？你什么意思？

Answer 2

CommonDialog打开的是文件，不能获得“文件夹”阿

Answer 3

'模块中：
Option ExplicitPublic Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End TypePublic Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(hWndOwner As Long, sPrompt As String) As StringDim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfoWith udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End WithlpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End IfBrowseForFolder = sPathEnd Function'窗体中：
Option ExplicitPrivate Sub Command1_Click()
'选择目录对话框
Dim bi As BrowseInfo '声明必要的变量
Dim rtn, pidl, path$, pos, t
Dim specin As String, specout As Stringbi.hWndOwner = Me.hWnd '使对话框处于屏幕中心
bi.lpszTitle = "选择目录..." '设置标题文字
bi.ulFlags = BIF_RETURNONLYFSDIRS '返回文件夹的类型
pidl = SHBrowseForFolder(bi) '显示对话框
path = Space(512) '设置字符数的最大值
t = SHGetPathFromIDList(ByVal pidl, ByVal path) '获得所选的路径
pos = InStr(path$, Chr$(0)) '从字符串中提取路径
specin = Left(path$, pos - 1)
If Right$(specin, 1) = "\" Then
    specout = specin
Else
    specout = specin + "\"
End Ifdebug.print specout
End Sub

Answer 4

xzp1030(向星星前进) :
Dim bi As BrowseInfo ? BrowseInfo是什么类型的啊？怎么通不过啊？

Answer 5

获取文件夹吗？
看看这个例子Enumerating Folders using FindFirstFile & FindNextFile APIBAS Module bas module: --------------------------------------------------------------------------------
 
Option ExplicitPublic Const MAX_PATH As Long = 260
    
'GetDriveType return values  
Public Const DRIVE_REMOVABLE As Long = 2
Public Const DRIVE_FIXED As Long = 3
Public Const DRIVE_REMOTE As Long = 4
Public Const DRIVE_CDROM As Long = 5
Public Const DRIVE_RAMDISK As Long = 6
  
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
  
Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End TypePublic Declare Function GetLogicalDriveStrings Lib "kernel32" _
   Alias "GetLogicalDriveStringsA" _
   (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As LongPublic Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
   (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As LongPublic Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _ 
   (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As LongPublic Declare Function FindClose  Lib "kernel32" _
 (ByVal hFindFile As Long) As Long
 
'flags for the user options  
Public displayExpanded As Boolean
Public displaySorted As Boolean
Public NoOfDrives As Integer
Public Function TrimNull(startstr As String) As String  Dim pos As Integer  pos = InStr(startstr, Chr$(0))
  
  If pos Then      
      TrimNull = Left$(startstr, pos - 1)
      Exit Function    
  End If
  
 'if this far, there was no Chr$(0), so return the string 
  TrimNull = startstr
  
End Function
Public Sub GetAllDrivesFolders(tvwTree As Control, nodParentNode As Node)'this routine uses a pre-dimmed array to speed up 
'processing.  Initially, the array is DIM'med to 
'200 elements; in the While loop it is increased 
'another 200 elements when "found Mod 200 = 0" 
'(or the number found divided by 200 equals 0).  
'At the end of the loop, it is resized down to the 
'total found.  This is significantly faster than 
'using a Redim Preserve statement for each element found.  Dim nodX As Node
  
  Dim WFD As WIN32_FIND_DATA
  Dim hFile As Long
  
  Dim sFile As String
  Dim sPath As String
   
  Dim i As Integer
  Dim r As Long
  Dim found As Integer
  
'assign the fullpath property to the path to search,
'assuring that the path is qualified. 
  If Right$(nodParentNode.FullPath, 1) <>  "\" Then
           sPath = nodParentNode.FullPath & "\"
  Else: sPath = nodParentNode.FullPath
  End If
    
 'find the first file matching the parameter \*.* 
  hFile = FindFirstFile(sPath & "*.*" & Chr$(0), WFD)
   
 'reset the counter flag 
  found = 0
  ReDim fArray(200)
  
  If hFile <> -1 Then
    sFile = TrimNull(WFD.cFileName)
    
    WFD.dwFileAttributes = vbDirectory
    
    While FindNextFile(hFile, WFD)
    
      sFile = TrimNull(WFD.cFileName)
        
     'ignore the 2 standard root entries 
      If (sFile <>  ".") And (sFile <>  "..") Then
          
          If (WFD.dwFileAttributes And vbDirectory) Then
          
            found = found + 1
              
           'if found is at 200, then add some more array elements 
            If found Mod 200 = 0 Then ReDim Preserve fArray(found + 200)
            
            fArray(found) = sFile
           
          End If
      
      End If
      
    Wend
    
  End If
  
  Call FindClose(hFile)
      
 'trim down the array to equal the elements found 
  ReDim Preserve fArray(found)
   
 'add the folders to the treeview 
  For i = 1 To found
    
    Set nodX = tvwTree.Nodes.Add(nodParentNode.Key, _
                                 tvwChild, _
                                 sPath & fArray(i) & "Dir", _
                                 fArray(i))
           
   'and get some more 
    GetAllDrivesFolders tvwTree, nodX
    
  Next i
  
  nodParentNode.Sorted = displaySorted
  nodParentNode.Expanded = displayExpandedEnd Sub
'--end block--'
 
 
 Form Code 
  
To the form, add the following code: --------------------------------------------------------------------------------
 
Option ExplicitPrivate Sub Form_Load()
 
 'centre the form  
  Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    
 'set initial options 
  displaySorted = True
  displayExpanded = False
  
 'load the system drives 
  GetSystemDrives
    
 'store the initial number of treeview elements for
 'later subtraction when presenting the total number
 'of files loaded (Treeview1_click routine) 
  NoOfDrives = Treeview1.Nodes.Count
  
  Label1.Caption = "Click on any drive letter to load its folders."End Sub
Private Sub Command1_Click()  Unload MeEnd Sub
Private Sub GetSystemDrives()  Dim nodX As Node
  Dim r As Long
  Dim allDrives As String
  Dim currDrive As String
  Dim drvIcon As Integer
    
 'get the list of all available drives 
  allDrives = rgbGetAvailableDrives()
  
  Do Until allDrives = Chr$(0)
    
   'strip off one drive item from the allDrives$ 
    currDrive = StripNulls(allDrives)
      
   'we can't have the trailing slash, so .. 
    currDrive = Left$(currDrive, 2)
      
   'add the drive to the treeview 
    Set nodX = Treeview1.Nodes.Add(, tvwChild, _
                                     currDrive & "Dir", _
                                     currDrive)
    nodX.Expanded = True
    
  Loop
  
 'force sorting of the drive letters 
  nodX.Sorted = TrueEnd Sub
Private Function rgbGetAvailableDrives() As String 
 'returns a single string of available drive
 'letters, each separated by a chr$(0)   Dim tmp As String
  
  tmp = Space$(64)
  Call GetLogicalDriveStrings(Len(tmp), tmp)
  
  rgbGetAvailableDrives = Trim$(tmp)End Function
Private Function StripNulls(startstr As String) As String 'Take a string separated by chr$(0)
 'and split off 1 item, shortening the
 'string so next item is ready for removal.
  Dim pos As Long  pos = InStr(startstr$, Chr$(0))
  
  If pos Then
      
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
    
  End IfEnd Function
Private Sub Treeview1_Click()  Dim nodX As Node
    
 'show a wait message for long searches 
  Label1.Caption = "Searching drive " & Treeview1.SelectedItem & " for folders ... please wait"
  DoEvents
    
 'identify the selected node 
  Set nodX = Treeview1.SelectedItem
    
'verify that it is valid> 
  If (UCase$(Right$(nodX.Key, 3)) = "DIR") And (nodX.Children = 0) Then
     GetAllDrivesFolders Treeview1, nodX
  End If
  
 'subtract NoOfDrives because initial drives loaded 
 'should not be counted as a folder 
  Label1.Caption = "Total folders displayed : " & Treeview1.Nodes.Count - NoOfDrives
  
End Sub
'--end block--'

Answer 6

我是要打开一个对话框，然后选择文件夹（CommonDialog是选择文件）。您的好像是遍历一个目录加到树型空间中，是吗？

Answer 7

俺给你一个吧！！！俺自己写滴！！！
[email protected]

Answer 8

看看这里
http://vbnet.mvps.org/index.html?code/browse/browsefolders.htm