怎样通过VB让用户选择一个目录而不是一个文件？急！

我现在需要实现下面功能：  
  通过一个界面让用户浏览，选择一个文件夹（而不是一个文件），程序可以获得文件夹的具体路径。  
  用commondialog控件必须要指定一个文件而不是文件夹。 问题点数：100、回复次数：8Top

1 楼lc_mtt（柠檬把大飞猪裤子一脱...被大飞猪投诉了）回复于 2006-03-01 17:51:05 得分 50

Private   Declare   Function   SHBrowseForFolder   _  
                  Lib   "shell32.dll"   Alias   "SHBrowseForFolderA"   _  
                  (lpBrowseInfo   As   BROWSEINFO)   As   Long  
  Private   Declare   Function   SHGetPathFromIDList   _  
                  Lib   "shell32.dll"   _  
                  (ByVal   pidl   As   Long,   _  
                  pszPath   As   String)   As   Long  
   
  Private   Type   BROWSEINFO  
          hOwner   As   Long  
          pidlRoot   As   Long  
          pszDisplayName   As   String  
          lpszTitle   As   String  
          ulFlage   As   Long  
          lpfn   As   Long  
          lparam   As   Long  
          iImage   As   Long  
  End   Type  
   
  Public   Function   ShowDir(MehWnd   As   Long,   _  
                  DirPath   As   String,   _  
                  Optional   Title   As   String   =   "请选择文件夹：",   _  
                  Optional   flage   As   Long   =   &H1,   _  
                  Optional   DirID   As   Long)   As   Long  
          Dim   BI   As   BROWSEINFO  
          Dim   TempID   As   Long  
          Dim   TempStr   As   String  
           
          TempStr   =   String$(255,   Chr$(0))  
          With   BI  
                  .hOwner   =   MehWnd  
                  .pidlRoot   =   0  
                  .lpszTitle   =   Title   +   Chr$(0)  
                  .ulFlage   =   flage  
                   
          End   With  
           
          TempID   =   SHBrowseForFolder(BI)  
          DirID   =   TempID  
           
          If   SHGetPathFromIDList(ByVal   TempID,   ByVal   TempStr)   Then  
                  DirPath   =   Left$(TempStr,   InStr(TempStr,   Chr$(0))   -   1)  
                  ShowDir   =   -1  
                   
          Else  
                  ShowDir   =   0  
                   
          End   If  
           
  End   Function  
   
   
  Private   Sub   Command1_Click()  
  ShowDir   Me.hWnd,   App.Path  
  End   Sub  
  Top

2 楼lc_mtt（柠檬把大飞猪裤子一脱...被大飞猪投诉了）回复于 2006-03-01 17:51:25 得分 0

或者：  
   
  Private   Type   BrowseInfo  
          hWndOwner   As   Long  
          pIDLRoot   As   Long  
          pszDisplayName   As   Long  
          lpszTitle   As   Long  
          ulFlags   As   Long  
          lpfnCallback   As   Long  
          lParam   As   Long  
          iImage   As   Long  
  End   Type  
  Const   BIF_RETURNONLYFSDIRS   =   1  
  Const   MAX_PATH   =   260  
  Private   Declare   Sub   CoTaskMemFree   Lib   "ole32.dll"   (ByVal   hMem   As   Long)  
  Private   Declare   Function   lstrcat   Lib   "kernel32"   Alias   "lstrcatA"   (ByVal   lpString1   As   String,   ByVal   lpString2   As   String)   As   Long  
  Private   Declare   Function   SHBrowseForFolder   Lib   "shell32"   (lpbi   As   BrowseInfo)   As   Long  
  Private   Declare   Function   SHGetPathFromIDList   Lib   "shell32"   (ByVal   pidList   As   Long,   ByVal   lpBuffer   As   String)   As   Long  
  Private   Sub   Form_Load()  
          'KPD-Team   1998  
          'URL:   http://www.allapi.net/  
          'KPDTeam@Allapi.net  
          Dim   iNull   As   Integer,   lpIDList   As   Long,   lResult   As   Long  
          Dim   sPath   As   String,   udtBI   As   BrowseInfo  
   
          With   udtBI  
                  'Set   the   owner   window  
                  .hWndOwner   =   Me.hWnd  
                  'lstrcat   appends   the   two   strings   and   returns   the   memory   address  
                  .lpszTitle   =   lstrcat("C:\",   "")  
                  'Return   only   if   the   user   selected   a   directory  
                  .ulFlags   =   BIF_RETURNONLYFSDIRS  
          End   With  
   
          'Show   the   'Browse   for   folder'   dialog  
          lpIDList   =   SHBrowseForFolder(udtBI)  
          If   lpIDList   Then  
                  sPath   =   String$(MAX_PATH,   0)  
                  'Get   the   path   from   the   IDList  
                  SHGetPathFromIDList   lpIDList,   sPath  
                  'free   the   block   of   memory  
                  CoTaskMemFree   lpIDList  
                  iNull   =   InStr(sPath,   vbNullChar)  
                  If   iNull   Then  
                          sPath   =   Left$(sPath,   iNull   -   1)  
                  End   If  
          End   If  
   
          MsgBox   sPath  
  End   SubTop

3 楼lc_mtt（柠檬把大飞猪裤子一脱...被大飞猪投诉了）回复于 2006-03-01 17:51:49 得分 0

更详细的：  
   
  名称]                       用API函数实现文件夹列表  
   
  [数据来源]               未知  
   
  [内容简介]               空  
   
  [源代码内容]  
   
  　　在安装软件等一些操作中，需要用户指定安装路径，现在软件的安装界面都是非常友好的，一般来说给出一个缺省路径，用户如不满意可以在文件夹列表中选择其他的路径。在WIN9X下，一般不再采用原来的先在驱动器列表框中选择驱动器再在相应的驱动器中选择相应文件夹的界面，而是采用的类似资源管理器中“所有文件夹”界面：最上层是“桌面”，然后是“我的电脑”、驱动器A、C、D...等，在一个列表框中用户可实现浏览所有驱动器及文件夹的操作。这种特色的文件列表没有现成的控件可供使用，但利用API函数可方便地实现。    
   
  　　实现方法：API函数SHBrowseForFolder可以提供这样的文件列表，它需要用到一个BROWSEINFO类型，此类型包括了列表框使用的参数，此类型的声明见下面的程序，其中这里用到的几个参数简单说明一下：    
   
  　　hwndOwner—当前窗口的句柄。    
   
  　　pidlRoot—从何根路径开始展开文件夹，缺省情况下从“桌面”开始展开。    
   
  　　lpszTitle—目录树上方的标题，用来给用户一些提示信息。    
   
  　　ulFlags—显示标志控制项：比如若赋值为BIF_BROWSEFORCOMPUTER，则只有当用户选择“我的电脑”时“确定”按钮才有效，这里我们需要的是    
   
  　　BIF_RETURNONLYFSDIRS，只有用户选择的是文件夹时“确定”按钮才有效。    
   
  　　此函数返回值是指向项目（ITEM）的一个指针，有了这个数值，再用API函数SHGetPathFromIDList可以获得具体的路径，如果用户按的是“取消”按钮，则返回值为NULL。    
   
  　　下面是一个例子，在窗体中放置一个命令按钮command1、一个文本框Text1，在窗体的声明部分API声明函数和类型及常量如下：    
   
  Option   Explicit  
   
  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   pidl   As   Long  
   
  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   Sub   command1_Click()  
  Dim   bi   As   BROWSEINFO  
  Dim   r   As   Long  
  Dim   pidl   As   Long  
  Dim   path   As   String  
  Dim   pos   As   Integer    
   
  句柄  
  bi.hOwner   =   Me.hWnd    
   
  展开根目录  
  bi.pidlRoot   =   0&    
   
  列表框标题  
  bi.lpszTitle   =   "请选择软件安装路径："  
  规定只能选择文件夹，其他无效  
   
  bi.ulFlags   =   BIF_RETURNONLYFSDIRS    
   
  调用API函数显示列表框  
   
  pidl   =   SHBrowseForFolder(bi)    
   
  利用API函数获取返回的路径  
   
   
  path   =   Space$(512)  
  r   =   SHGetPathFromIDList(ByVal   pidl&,   ByVal   path)  
  If   r   Then  
  pos   =   InStr(path,   Chr$(0))  
  Text1   =   Left(path,   pos   -   1)  
  Else:   Text1   =   ""  
  End   If  
  End   Sub    
   
  　　运行此程序，单击命令按钮，就可以看到和资源管理器中一样的“所有文件夹”列表了。    
   
  　　此程序在中文WIN95/98、中文VB6.0专业版下调试通过。Top

4 楼zq972（最近不想写代码，好累~~~~）回复于 2006-03-01 18:46:17 得分 1

这里总是有很多高手，以后要多来这里逛逛，哈哈！Top

5 楼xiaoyaolz（逍遥浪子）回复于 2006-03-01 20:14:26 得分 1

这个超不难了Top

6 楼Dickson（沧海冷心）回复于 2006-03-01 21:12:25 得分 2

工具栏有控件啊，不要加FILE控件就行了Top

7 楼rainstormmaster（暴风雨 v2.0）回复于 2006-03-02 08:24:55 得分 45

Option   Explicit  
  '首先引用Microsoft   Shell   Controls   And   Automation  
   
  Private   Sub   Command1_Click()  
  Dim   mshell   As   New   Shell  
  Dim   mfolder   As   Folder  
  Set   mfolder   =   mshell.BrowseForFolder(Me.hWnd,   "test",   &H10)  
  If   ObjPtr(mfolder)   =   0   Then  
  Exit   Sub  
  End   If  
  MsgBox   mfolder.Self.Path  
  End   SubTop

8 楼junki（『.NET技术争霸天下』）回复于 2006-03-02 08:39:02 得分 1

hehe,还是楼上的厉害.Top

相关问题

• .net
• 文件夹
• 函数
• bi
• 选择
• 用户
• 文件
• 控件
• longprivate
• 按钮

• 帖主：xys1995
• lc_mtt
• zq972
• xiaoyaolz
• Dickson
• rainstormmaster
• junki

• Visual Basic类图书
• Visual Basic类源码下载