找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 442|回复: 3

[求助]:VB中可以通过调用CommonDialog控件来选择文件,怎样得到一个文件夹而不是文件

[复制链接]
发表于 2003-11-20 17:36:58 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
VB中可以通过调用CommonDialog控件来选择文件,怎样得到一个文件夹而不是文件名呢?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2003-11-20 19:06:35 | 显示全部楼层
Option Explicit
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) 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
'API函数SHBrowseForFolder提供文件列表,它需要用到一个BROWSEINFO类型,此类型包括了列表框使用的参数,
'此类型的声明见下面的程序,其中这里用到的几个参数简单说明一下:
' 此函数返回值是指向项目(ITEM)的一个指针,有了这个数值,再用API函数SHGetPathFromIDList可以获得具体的路径,如果用户按的是“取消”按钮,则返回值为NULL。
    Private Type BROWSEINFO
        hOwner As Long              '当前窗口的句柄。
        pidlRoot As Long            'pidlRoot—从何根路径开始展开文件夹,缺省情况下从“桌面”开始展开。
        pszDisplayName As String
        lpszTitle As String         'lpszTitle—目录树上方的标题,用来给用户一些提示信息。
        ulFlags As Long             'ulFlags—显示标志控制项:比如若赋值为
                                    '       BIF_BROWSEFORCOMPUTER,则只有当用户选择“我的电脑”时“确定”按钮才有效,
                                    '       这里我们需要的是BIF_RETURNONLYFSDIRS,只有用户选择的是文件夹时“确定”按钮才有效。
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
    Const BIF_RETURNONLYFSDIRS = &H1
   
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
        "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    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 GetPath(hwnd As Long) As String
    Dim bi As BROWSEINFO '声明必要的变量
    Dim rtn$, pidl$, path$, pos%, t, SpecIn, SpecOut
    bi.hOwner = 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 If
    GetPath = SpecOut
End Function

Public Function GetFile(hwnd As Long) As String
    Dim ofn As OPENFILENAME
    Dim rtn As String
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = hwnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "所有文件"
    ofn.lpstrFile = Space(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = App.path
    ofn.lpstrTitle = "打开文件"
    ofn.flags = 6148
    rtn = GetOpenFileName(ofn)
    If rtn >= 1 Then
        GetFile = ofn.lpstrFile
    Else
        GetFile = ""
    End If
End Function

Public Function GetTempName() As String
     Dim TempFileName As String * 256
     Dim TmpFilePrefix As String
     Dim x As Long
     Dim DriveName As String
     DriveName = Mid(App.path, 1, 2)
     TmpFilePrefix = "Tmp"
       x = GetTempFileName(DriveName, TmpFilePrefix, 0, TempFileName)
       GetTempName = Left$(TempFileName, InStr(TempFileName, Chr(0)) - 1)
End Function
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-11-20 20:14:03 | 显示全部楼层
Public Function GetPath(hwnd As Long) As String

请问hwnd 应该用什么值
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 181个

财富等级: 日进斗金

发表于 2003-11-20 22:59:14 | 显示全部楼层
hwnd代表一个窗口的句柄,在这儿表示调用浏览文件夹的窗体的句柄。如果在VB的窗体中使用,可以将窗体的句柄传给它。而在模块、类模块或者VBA中可以用0来代替。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-29 13:20 , Processed in 0.329436 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表