module1.bas

利用windows的API来注册自动OCX

Attribute VB_Name = "ModGetMultiFiles"
Option Explicit

Public Sub GetMultiFiles(ByVal FileName As String, _
                strPath As String, strFileName() As String)
    
        Dim strMultiFilename As String
        Dim lngFileLength As Long
        Dim intNullPos As Integer
        Dim i As Integer

        intNullPos = InStr(1, FileName, vbNullChar)
        ' 如果intNullPos = 0，则表示只传递过来一个文件。
        If intNullPos = 0 Then
            ReDim Preserve strFileName(0) As String
            ' 获得文件名。
            strFileName(0) = Dir(FileName, vbDirectory)
            ' 减1是为了将文件路径和文件名之间的分隔符去掉。
            lngFileLength = Len(FileName) - Len(strFileName(0)) - 1
            ' 获得文件所在的路径。
            strPath = Left(FileName, lngFileLength)
            Exit Sub
        End If
        
        ' 获得去掉文件路径后的多文件名组成的字符串长度。
        lngFileLength = Len(FileName) - intNullPos
        ' 获得多个文件名组成的字符串。
        strMultiFilename = Right(FileName, lngFileLength)
        
        ' 获得文件所在的路径。
        strPath = Left(FileName, intNullPos - 1)
        '防止在根目录
        If Right(Trim(strPath), 1) = "\" Then
        strPath = Mid(strPath, 1, Len(strPath) - 1)
        End If
        ' 此语句用于下面的循环语句。
        intNullPos = InStr(1, strMultiFilename, vbNullChar)

        ' 只要intNullPos不等于零，
        '    则表示多个文件名的变量strMultiFilename中有空字符存在，
        '    暗示strMultiFilename还有两个以上的文件名。
        i = 0
        Do While intNullPos > 0
            
            ' 重新定义动态数组。
            ReDim Preserve strFileName(i) As String
            ' 从strMultiFilename中获得文件名。
            strFileName(i) = Left(strMultiFilename, intNullPos - 1)
            ' 从strMultiFilename中去掉已提取的文件后所得的字符串长度。
            lngFileLength = Len(strMultiFilename) - intNullPos
            ' 将strFileName(i)从strMultiFilename中去掉，
            '   从而重新获得strMultiFilename的值。
            strMultiFilename = Right(strMultiFilename, lngFileLength)
            ' 重新检查strMultiFilename变量是否有空字符。
            intNullPos = InStr(1, strMultiFilename, vbNullChar)
            i = i + 1
        Loop
        ' 当第一次获得intNullPos为零时，仍有一个文件名没有被提取出来。
        ReDim Preserve strFileName(i) As String
        strFileName(i) = strMultiFilename

End Sub