利用“打开文件”对话框一次打开获得多个文件名

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  利用“打开文件”对话框一次打开获得多个文件名。
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓
'  自写函数 GetMultiFileNameDialog 中的参数及其返回值:
'
'  OwnerHandle ---- Long,必要参数,对话框宿主句柄,一般设置为一个窗体的句柄。
'  blnIsMulti ----- Boolean,可选参数,默认值为 False。指明是否可获取多个文件名。
'  strFileType ---- String,可选参数,文件类型描述、扩展名。
'                   函数已内置“所有文件 (*.*)”项目,用户没有设置该参数时此项目为默认值。
'                   如果用户设置了该参数,则函数内置项目将出现在用户定义类型项目的后面,
'                   用户要设置函数内置项目为默认项目时,只需将下面的 intFilterIndex 参数
'                   设置为 用户定义项目数 + 1 即可。
'  intFilterIndex - Integer,可选参数,默认值为 1。
'                   用以设置“打开文件”对话框中的“文件类型”的默认项目条。
'  strInitialPath - String,可选参数,默认值为程序所在目录。
'                   用以设置“打开文件”对话框的起始目录。
'
'  返回值 --------- String(),返回一个文件名数组,GetMultiFileNameDialog(0) 存放文件路径,
'                   从 1 开始存放文件名,包括只有一个文件时的情况。
'                   在 GetMultiFileNameDialog(0) 返回的路径中已经包含了最后的“/”。
'                   如果没有选择任何文件,GetMultiFileNameDialog(0) 返回值为 "" (空串)。
'〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓〓

Private 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

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Function GetMultiFileNameDialog(ByVal OwnerHandle As Long, Optional ByVal blnIsMulti As Boolean = False, Optional ByVal strFileType As String, Optional ByVal intFilterIndex As String = 1, Optional ByVal strInitialPath As String) As String()
    Dim OpenFileDialog As OPENFILENAME
    Dim tempStr As String
    Dim tempFileName() As String
    Dim P As Long, N As Long

    '初始化“打开文件”对话框。
    OpenFileDialog.lStructSize = Len(OpenFileDialog)
    OpenFileDialog.hwndOwner = OwnerHandle
    OpenFileDialog.hInstance = App.hInstance
    OpenFileDialog.lpstrFileTitle = Space(255)
    OpenFileDialog.nMaxFileTitle = 256
    OpenFileDialog.lpstrTitle = "打开文件" '设置对话框标题
    '设置“打开文件”对话框过滤器。
    OpenFileDialog.lpstrFilter = strFileType & "所有文件 (*.*)" & Chr$(0) & "*.*" & Chr$(0)
    OpenFileDialog.nFilterIndex = intFilterIndex
    '设置“打开文件”对话框初始目录。
    OpenFileDialog.lpstrInitialDir = IIf(strInitialPath = "", App.Path, strInitialPath)

    '设置对话框是否为多选。
    If blnIsMulti Then
        OpenFileDialog.flags = &H80200
        OpenFileDialog.lpstrFile = Space(102400) '设置文件名缓冲区大小。等于所有文件名总字符长度 - 1。
        OpenFileDialog.nMaxFile = 102401 '设置“打开文件”对话框所有被打开文件名的总字符长度,如果是多选就尽量把它设置得大一些。
    Else
        OpenFileDialog.lpstrFile = Space(255)
        OpenFileDialog.nMaxFile = 256
        OpenFileDialog.flags = 6148
    End If

    If GetOpenFileName(OpenFileDialog) > 0 Then
        '提取所有文件名。
        tempStr = OpenFileDialog.lpstrFile
    End If

    '如果用户取消了,或没有选择任何文件,处理返回仍为数组形式,GetMultiFileNameDialog(0) 为 "" (空串)。
    If tempStr = "" Then
        ReDim tempFileName(0)
        tempFileName(0) = ""
        GetMultiFileNameDialog = tempFileName '返回文件名数组。
        Exit Function
    End If

    P = InStrRev(tempStr, Chr(160)) '为 UNICODE。
    tempStr = Left(tempStr, P - 1) '去掉多余的缓冲区空串。

    If UBound(Split(tempStr, Chr(160))) < 2 Then '如果只选择了一个文件。
        '提取路径。
        ReDim tempFileName(1) '至少有一个文件。

        P = InStrRev(tempStr, "/") 'P 取得“/”所在位置
        tempFileName(0) = Left(tempStr, P - 1)
        tempFileName(1) = Mid(tempStr, P + 1)
    Else '选择了多个文件。
        Do While tempStr <> ""
            P = InStr(tempStr, Chr(160)) '为 UNICODE。
            ReDim Preserve tempFileName(N)

            '如果没有空格(只剩余一个文件)。
            If P = 0 Then
                tempFileName(N) = tempStr
                Exit Do
            Else
                tempFileName(N) = Left(tempStr, P - 1)
                tempStr = Mid(tempStr, P + 1)
                N = N + 1
            End If
        Loop
    End If

    '处理路径。
    tempStr = tempFileName(0)
    tempFileName(0) = IIf(Len(tempStr) = 3, tempStr, tempStr & "/")

    '返回文件名数组。
    GetMultiFileNameDialog = tempFileName
End Function


'e.g:
Private Sub Main()
    Dim strFileNameAny() As String, I As Integer
    Dim eName As String
    eName = "文本文件 (*.txt)" & Chr$(0) & "*.txt" & Chr$(0)
    eName = eName & "位图文件 (*.bmp)" & Chr$(0) & "*.bmp" & Chr$(0)
    eName = eName & "图片文件 (*.gif;*.jpg)" & Chr$(0) & "*.gif;*.jpg" & Chr$(0)

    '这里为了举例需要将宿主句柄设置为 0,在实际使用中不要这样设置,否则会发生 N 种不可预知的错误。
    strFileNameAny = GetMultiFileNameDialog(0, True, eName, 4, "c:")
    If UBound(strFileNameAny) > 0 Then
        For I = 0 To UBound(strFileNameAny)
            Debug.Print strFileNameAny(I)
        Next
    End If
    Debug.Print I '输出数组中有多少个项目。
End Sub

  • 1
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值