Home
Home

--- Soumis par Dev Ashish---

Retourner un nom unique de fichier, en séquence.

(Q) Il me faut exporter à peu près 50 fichiers, depuis ma base de données, chaque nuit. Le nom des fichiers sont du genre tmp00010.dat, tmp00011.dat, etc. Je sais comment générer chaque exportation à travers d'une boucle, mais comment générer la séquence de noms, tous uniques, pour ces fichiers, étant connu le répertoire où ils doivent être.

(A) Couper-coller la fonction suivatne dans un nouveau module, puis utiliser la fonction fUniqueFile un nom séquenciel unique. La fonction se vérifie contre l'existence du nom de fichier qu'elle retourne.

'***************** Code Start ***************
Function fUniqueFile(strDir As String, intMaxFiles As Integer, _
                    strPadChar As String, strFileInitName As _
                    String, Optional strFileExt) As String
'===========================
'Retourne un nom de fichier séquenciel unique pour exportation
'La fonction requiert:
'   strDir = Répertoire des fichiers
'   intMaxFiles = Nombre maximum de nom à retourner
'   strPadChar = Caractère unique  pour remplissage du nom
'   strFileInitName = Les trois caratères de gauche (préfixe) communs aux noms
'   (Optionel) strFileExt = Extension à utiliser
'Exemple d'appel de la fonction:
'msgbox "Nom disponible pour le fichier: " & _
'  fUniqueFile("C:\DataFiles", 500,"0", "dat")
'  et ce, sans fournir d'extension. Si on 
'désire fournir une extension, utiliser:
'  fUniqueFile("C:\DataFiles",500,"0","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)
            'Obtenir le premier nom contre lequel on se comparera
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5) _
                        & "." & strFileExt
        Else
            strTmp = Dir(strDir & "\*.*")
             'Obtenir le premier nom contre lequel on se comparera
            strtmpFile = strFileInitName & Lpad(CStr(i), strPadChar, 5)
        End If
    
        Do While strTmp <> ""
            If strTmp = strtmpFile Then
                'Si le fichier existe,
                'chercher avec le prochain
                boolNextI = False
                Exit Do
            Else
                'Le nom n'est pas utilsé
                boolNextI = True
            End If
            'autrement, chercher le prochain dans le répertoire
            strTmp = Dir
        Loop
    
        If boolNextI Then
            'Terminer si un nom satisfaisant fut trouvé
            Exit For
        End If
    Next i
  
    'On possède maintenant notre
    'nom de fichier unique
    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 **********************