Créer un nom de fichier unique.

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