Nous avons souvent besoin sous Access de créer des noms de fichiers uniques comme par exemple en exportation pour ne pas écraser un fichier existant. Mais il faut
que le nouveau fichier créé porte bien le nom exact que nous désirons. Pour cela, nous ajoutons un indice entre [ ] au nom de fichier. Le fichier « c:/export/monfichier.xls » devra donc
s’appeler « c:/export/monfichier[1].xls » si le nom du premier fichier existe déjà. Il en va de même si plusieurs fichiers avec indice sont déjà créés, il faudra trouver le premier
indice manquant pour que le nom du nouveau fichier soit correct.
Chaque fois que nous allons créer un fichier export (dans l’exemple ci-dessus) nous devrons vérifier que le fichier n’existe pas ou qu’un même fichier ne possède pas
le même indice.
Nous avons donc à notre disposition une nouvelle fonction qui permet de vérifier si le nom existe et si oui, qui nous retourne un nom de fichier avec un indice
correct.
Cette fonction sera d’un grand secours dans le cas de la sélection d’un nom de fichier par l’opérateur qui pourra se contenter de sélectionner un des noms et la
fonction ajustera l’indice.
De plus, nous passons optionnellement une valeur d’indice à partir de laquelle le test doit avoir lieu.
Donc, chaque fois que nous créerons un fichier , nous vérifierons l’unicité du nom par la fonction :
NomduFichier = FichierUnique(NomduFichier, indice)
L’indice est optionnel et sa valeur par défaut est fixée à 1. L’indice calculé par la fonction sera le premier indice manquant à partir de l’indice fourni.
Exemple : si vous exécutez
MsgBox FichierUnique("F:/Mes Documents sur Data/Download/Essais/GetOfficeButton.xls"), la fonction pourra vous retourner la valeur :
F:/Mes Documents sur Data/Download/Essais/GetOfficeButton[12].xls
Parce que votre dossier contient déjà 12 fichiers portant ce même nom.
Si aucun fichier n’existe dans le dossier, la fonction ne modifie pas le nom du fichier.
Fonction à placer dans un module standard de n’importe quel nom :
Option Compare Database
Option Explicit
Private Declare Function GetFileAttributes Lib "kernel32.dll" _
Alias "GetFileAttributesA" (ByVal lpFichier As String) As Long
Dim Dossier As String
Dim Fichier As String
Dim Extension As String
Dim wFichier As String
Dim Séparateur As Integer
Dim I As Integer
Public Function FichierUnique(NomFichier As String, _
Optional
PremierIndice As Integer = 1) _
As String
wFichier = NomFichier
If Nz(wFichier, "") <> "" Then
If GetFileAttributes(wFichier) <> &HFFFFFFFF Then
Séparateur = InStrRev(wFichier, "")
If Séparateur > 0 Then
Dossier = Left(wFichier, Séparateur)
wFichier = Mid(wFichier, Séparateur + 1)
Else
Dossier = ""
End If
Séparateur = InStrRev(wFichier, ".")
If Séparateur > 0 Then
Extension = Mid(wFichier, Séparateur)
Fichier = Left(wFichier, Séparateur - 1)
Else
Fichier = wFichier
Extension = ""
End If
I = PremierIndice
Do
wFichier = Dossier & Fichier & "[" & I & "]" & Extension
I = I + 1
Loop While GetFileAttributes(wFichier) <> &HFFFFFFFF
End If
End If
FichierUnique = wFichier
End Function
Commentaires Récents