dlgselectfileinfo.bas

来自「很好的教程原代码！」· BAS 代码 · 共 82 行

Attribute VB_Name = "ModDlgSelectFileInfo"
Option Explicit

'包含函数： GetDlgSelectFileInfo
'函数功能： 获取从CommonDialog中选取的文件信息

'自定义类型，用于DlgSelectFileInfo函数
Type DlgFileInfo
    iCount As Long
    sPath As String
    sFile() As String
End Type

'功能：     返回CommonDialog所选择的文件数量和文件名
'参数说明:  strFileName是CommonDialog.Filename
'函数类型:  DlgFileInfo。这是一个自定义类型，声明如下：
'               Type DlgFileInfo
'                   iCount As Long
'                   sPath As String
'                   sFile() As String
'               End Type
'           其中，iCount为选择文件的数量，sPath为所选文件的路径，sFile()为所选择的文件名
'注意事项:  在CommonDialog.ShowOpen后立即使用，以免当前路径被更改
'           在打开了*.pif文件后须将Filename属性置空，否则当选取多个*.pif文件后，当前路径会改变会
'           在CommonDialong.Flags属性中使用cdlOFNNoDereferenceLinks风格，就可以正确的返回*.pif文件的文件名了

Public Function GetDlgSelectFileInfo(strFilename As String) As DlgFileInfo
    
    '思路： 用CommonDialog控件选择文件后，其Filename属性值如下：
    '       1、如果选择的是"C:\Test.txt"，  Filename="C:\Test.txt"，    CurDir()="C:\"
    '       2、如果选择的是"C:\1\Test.txt"，Filename="C:\1\Test.txt"，  CurDir()="C:\1"
    '       3、如果选择的是"C:\1.txt"和"C:\2.txt"，则：
    '                                   Filename="C:\1 1.txt 2.txt"，  CurDir()="C:\1"
    '       因此先将路径分离开，再利用多文件之间插入的Chr$(0)字符分解各个文件名即可。
    
    Dim sPath, tmpStr As String
    Dim sFile() As String
    Dim iCount As Integer
    Dim I As Integer
    
    On Error GoTo ErrHandle
    
    sPath = CurDir()  '获得当前的路径，因为在CommonDialog中改变路径时会改变当前的Path
    tmpStr = Right$(strFilename, Len(strFilename) - Len(sPath)) '将文件名分离出来
    
    If Left$(tmpStr, 1) = Chr$(0) Then
        '选择了多个文件(表现为第一个字符为空格)
        For I = 1 To Len(tmpStr)
            If Mid$(tmpStr, I, 1) = Chr$(0) Then
                iCount = iCount + 1
                ReDim Preserve sFile(iCount)
            Else
                sFile(iCount) = sFile(iCount) & Mid$(tmpStr, I, 1)
            End If
        Next I
    Else
        '只选择了一个文件(注意：根目录下的文件名除去路径后没有"\"）
        iCount = 1
        ReDim Preserve sFile(iCount)
        If Left$(tmpStr, 1) = "\" Then tmpStr = Right$(tmpStr, Len(tmpStr) - 1)
        sFile(iCount) = tmpStr
    End If
    
    GetDlgSelectFileInfo.iCount = iCount
    ReDim GetDlgSelectFileInfo.sFile(iCount)
    
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    GetDlgSelectFileInfo.sPath = sPath
    
    For I = 1 To iCount
        GetDlgSelectFileInfo.sFile(I) = sFile(I)
    Next I
    
    Exit Function

ErrHandle:
    MsgBox "GetDlgSelectFileInfo函数执行错误！", vbOKOnly + vbCritical, "自定义函数错误"

End Function