新版"文件对话框"

时　间:2010-12-05 00:00:00
作　者:咱家是猫   ID：85  城市：广州
摘　要:应一些网友要求(要求加入多行文件类型筛选),而对原来写的文件对话框进行了改版
正　文:

,现共享如下:

Function GetFileName(Optional ByVal DialogType As MsoFileDialogType = msoFileDialogFilePicker, Optional ByVal TitleStr As String = "打开", Optional ByVal FilterStr As String = "所有文件(*.*)", Optional ByVal MultiSelect = False, Optional ByVal PathStr As String) As String
'此函数需要引用Microsoft Office 12.0(或14.0) Object Library
'参数说明：
'DialogType 打开文件对话框的类型
    'msoFileDialogFilePicker    文件对话框
    'msoFileDialogFolderPicker  文件夹对话框
    'msoFileDialogOpen          打开...
    'msoFileDialogSaveAs        另存为...
'TitleStr   对话框标题文字
'FilterStr  文件类型筛选条件
    '本条件只对打开文件有效
    '如果要设置此字符串,请遵循以下格式("条件文字描述(类型设定)),多条件之间用";"号隔开.如:
    '"BMP格式文件(*.BMP);JPG格式文件(*.JPG);TXT文件(*.TXT)"
'MultiSelect    是否多选
    '设置文件对话框是否可以多选(基本上很少用)
'PathStr    默认路径
    '如果未指定,则默认为当前实例路径
'作者说明:以上各参数都已经设置了可缺少默认的,(意思是:你常用的打开一个文件夹,选择一个文件功能是可以一个参数都不用输入的)
'最简单的你可以这么用:FileName=GetFileName()
'最复杂的你可以这么用(哈哈,够长)如下:
'FileName = GetFileName(msoFileDialogFilePicker, "打开图片文件", "BMP格式图片(*.bmp);JPG格式图片(*.jpg);GIF格式图片(*.gif)", False, "D:\Documents\")
'作者:咱家是猫 QQ 130036500
'日期:2010年12月04日

On Error Resume Next
    Dim dlgOpen As FileDialog
    Dim I As Integer, S As String, A As String, B As String
    Set dlgOpen = Application.FileDialog(DialogType)
    With dlgOpen
        .title = TitleStr
        .Filters.Clear
        For I = 0 To UBound(Split(FilterStr, ";", -1), 1)
            S = Split(FilterStr, ";", -1)(I)
            A = Left(S, InStr(S, "(") - 1)
            B = Mid(S, InStr(S, "(") + 1)
            B = Left(B, InStr(B, ")") - 1)
            .Filters.Add A, B
        Next
        .AllowMultiSelect = MultiSelect
        If IsMissing(PathStr) Then
            .InitialFileName = CurrentProject.Path
        Else
            .InitialFileName = PathStr
        End If
        .Show
    End With
    If dlgOpen.SelectedItems.Count > 0 Then
        GetFileName = dlgOpen.SelectedItems(1)
    Else
        GetFileName = ""
    End If
    Set dlgOpen = Nothing
End Function



Access软件网QQ交流群 (群号:483923997) 　　　　　　Access源码网店