Home  |  About  |   Search   

What's New
Table Of Contents
Credits
Netiquette
10 Commandments 
Bugs
Tables
Queries
Forms
Reports
Modules
APIs
Strings
Date/Time
General
Downloads
Resources
Search
Feedback
mvps.org

RunCommand Constants

Terms of Use


 

API: Return a unique filename in a sequence

Author(s)
Dev Ashish

(Q) I need to export about 50 files from my database every night. The files have a fixed name, for example, tmp00010.Dat, tmp00011.Dat etc. I know how to generate each export file with loops in code. But I don't know how to generate such a sequential and unique file name given an export directory.

(A) Paste the following function in a new module and use the Function fUniqueFile to generate a unique sequential filename. The function checks for existance of each file before returning the unique name back.

'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fUniqueFile(strDir As String, intMaxFiles As Integer, _
                    strPadChar As String, strFileInitName As _
                    String, Optional strFileExt) As String
'===========================
'Function returns a sequential unique filename for export
'Function Accepts:
'   strDir = Location of all files
'   intMaxFiles = Max # of files to return
'   strPadChar = SINGLE character to pad the filename with
'   strFileInitName = Left 3 characters of filename (common)
'   (Optional) strFileExt = File extension to use
'call the function as
'msgbox "Free File Name is " & _
'  fUniqueFile("C:\DataFiles", 500, "dat")
'  Note No Extension is provided
'With Extension
'  fUniqueFile("C:\DataFiles",500,"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)
            'Get the First File Name to compare against
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5) _
                        & "." & strFileExt
        Else
            strTmp = Dir(strDir & "\*.*")
            'Get the First File Name to compare against
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5)
        End If
    
        Do While strTmp <> ""
            If strTmp = strtmpFile Then
                'File Exists, break out
                'and get next LPad name
                boolNextI = False
                Exit Do
            Else
                'Unique file name
                boolNextI = True
            End If
            'else get the next name in DIR
            strTmp = Dir
        Loop
    
        If boolNextI Then
            'Unique Name found, end For
            Exit For
        End If
    Next i
  
    'You should now have the
    'Unique file name
    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 **********************

1998-2009, Dev Ashish & Arvin Meyer, All rights reserved. Optimized for Microsoft Internet Explorer