Function fUniqueFile(strDir As String, intMaxFiles As Integer, _
                    strPadChar As String, strFileInitName As _
                    String, Optional strFileExt) As String
    '================================================================
    ' 函数返回一个连续、唯一的文件名
    ' 函数参数说明:
    '   strDir: 文件所在的目录位置
    '   intMaxFiles: 返回的最大文件数
    '   strPadChar: 文件格式串
    '   strFileInitName: 文件前缀，通常为3个字符
    '   (Optional) strFileExt: 扩展文件名(可选参数) = File extension to use
    ' 调用例子:
    '   msgbox "Free File Name is " & _
    '          fUniqueFile("C:\DataFiles", 500, "00000", "dat")
    '   注: 没有提供文件扩展名
    '  使用文件扩展名
    '          fUniqueFile("C:\DataFiles", 500, "00000", "da", "out")
    '===============================================================

    Dim strtmpFile As String
    Dim strTmp As Variant
    Dim i As Integer
    Dim boolNextI As Boolean

    On Error GoTo funiqueFile_Error
    
    For i = 1 To intMaxFiles
        boolNextI = False
        ' 如果不是未给文件扩展文件名
        If Not IsMissing(strFileExt) Then
            strTmp = Dir(strDir & "\*." & strFileExt)
            ' 第一个文件的文件名
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5) _
                        & "." & strFileExt
        Else
            strTmp = Dir(strDir & "\*.*")
            ' 第一个文件的文件名
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5)
        End If
    
        Do While strTmp <> ""
            If strTmp = strtmpFile Then
                ' 文件存在，退出并获取下一个格式串
                boolNextI = False
                Exit Do
            Else
                ' 唯一文件
                boolNextI = True
            End If

            ' 否则比较下一个区配文件
            strTmp = Dir
        Loop
    
        If boolNextI Then
            ' 找到唯一文件名，退出For循环
            Exit For
        End If
    Next i
  
    ' 这时已经唯一文件
    fUniqueFile = strtmpFile
    
fUniqueFile_Success:
    Exit Function
funiqueFile_Error:
    fUniqueFile = vbNullString
    Resume fUniqueFile_Success
End Function

Function Lpad(Myvalue$, MyPadCharacter$, MyPaddedLength%)
    Dim PadLength As Integer
    Dim X As Integer

    PadLength = MyPaddedLength - Len(Myvalue)
    Dim PadString As String
    For X = 1 To PadLength
        PadString = PadString & MyPadCharacter
    Next
    Lpad = PadString + Myvalue
End Function
'************ Code End **********************