--- 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 **********************