Nom de fichier unique (incremente)

Commenter

Contenu du snippet

Pas de Zip, je sais, faut copier coller...

Cette fonction m'a été demandée par un Ami.
J'en fait profiter tout le monde, en la mettant à disposition.
Rien de bien exceptionnel, mais cette fonction peut s'avérer utile.

Elle permet d'obtenir un nom de fichier, qui s'incrémente si un fichier de ce nom existe.
Pas clair ?

Je souhaite enregistrer le fichier
C:\Rep\a.jpg

seulement, il existe déjà... je ne veux pas l'ecraser, je peux faire :

FileName = GetUnique ( "C:\Rep\a.jpg" )
et FileName va contenir "C:\Rep\a(1).jpg"

simple, n'est-il pas ?

Source / Exemple : 


Public Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Const INVALID_FILE_ATTRIBUTES As Long = &HFFFFFFFF

'# Permet de tester l'existence d'un fichier (plus fiable que Dir$ qui se plante sur des chemins réseaux manquants
Public Function IsFileExisting(ByRef FilePath As String) As Boolean
    '# Cette API permet de savoir si le fichier est ReadOnly, etc
    '# Elle renvoie INVALID_FILE_ATTRIBUTES si le fichier n'existe pas
    IsFileExisting = (GetFileAttributes(FilePath) <> INVALID_FILE_ATTRIBUTES)
End Function

'# Fonction permettant de dupliquer un nom de fichier :
'# GetUnique ( C:\a.mp3 ) renverra C:\a(1).mp3 si ledit fichier existe
'# Indicators permet d'indiquer les séparateurs utilisés... () [] etc
'# FirstIndex permet de spécifier le premier indice utilisé
Public Function GetUnique(ByRef FileName As String, Optional ByRef Indicators As String = "()", Optional ByVal FirstIndex As Integer = 1) As String
Dim i As Integer
'# Le nom de fichier est séparé en deux parts
'# 'C:\a(' et ').mp3'
Dim Parts(1 To 2) As String
    If Not IsFileExisting(FileName) Then
        '# Le fichier existe, on ne se pose pas de question
        GetUnique = FileName
    Else
        '# On sépare les parties du nom de fichier
        i = InStrRev(FileName, ".")
        If i <> 0 Then
            Parts(2) = Mid$(FileName, i)
            Parts(1) = Left$(FileName, i - 1)
        Else
            '# Pas d'extension, la première partie est le nom complet
            Parts(1) = FileName
        End If
        '# Si l'indicateur (forcément deux caractères) est fournis, on complète les deux parties du nom
        If Len(Indicators) = 2 Then
            Parts(1) = Parts(1) & Left$(Indicators, 1)
            Parts(2) = Right$(Indicators, 1) & Parts(2)
        End If

        i = FirstIndex
        Do
            '# On reconstruit un nom de fichier
            GetUnique = Parts(1) & i & Parts(2)
            i = i + 1
            '# On boucle tant que le fichier existe, après avoir incrémenté le compteur
        Loop While IsFileExisting(GetUnique)
    End If
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Renfield)