Nom de fichier unique (incremente)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 687 fois - Téléchargée 28 fois

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

Ajouter un commentaire Commentaires
Messages postés
24
Date d'inscription
jeudi 21 novembre 2002
Statut
Membre
Dernière intervention
20 février 2010

Merci, je test, très pratique comme fonction.
A rajouter au code snippets.
Merci beaucoup a plus
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
68
J'ignore si cela existe...

une traduction donnerait :
Public Function GetUnique(ByRef vsFileName As String, Optional ByRef vsIndicators As String "()", Optional ByVal vnFirstIndex As Integer 1) As String
Dim i As Integer
'# Le nom de fichier est séparé en deux parts
'# 'C:\a(' et ').mp3'
Dim sBegin As String
Dim sEnd As String
If Not File.Exists(vsFileName) Then
'# Le fichier existe, on ne se pose pas de question
GetUnique = vsFileName
Else
'# On sépare les parties du nom de fichier
i = vsFileName.LastIndexOf(".")
If i <> 0 Then
sEnd = vsFileName.Substring(i)
sBegin = vsFileName.Substring(0, i)
Else
'# Pas d'extension, la première partie est le nom complet
sBegin = vsFileName
sEnd = String.Empty
End If
'# Si l'indicateur (forcément deux caractères) est fournis, on complète les deux parties du nom
If vsIndicators.Length = 2 Then
sBegin &= vsIndicators.Substring(0, 1)
sEnd = vsIndicators.Substring(1) & sEnd
End If

i = vnFirstIndex
Do
'# On reconstruit un nom de fichier
GetUnique = sBegin & i & sEnd
i = i + 1
'# On boucle tant que le fichier existe, après avoir incrémenté le compteur
Loop While File.Exists(GetUnique)
End If
End Function

sans oublier le

Imports System.IO
Messages postés
24
Date d'inscription
jeudi 21 novembre 2002
Statut
Membre
Dernière intervention
20 février 2010

Bonjours,exist'il une fonction telle que cella en vb.net.
J'ai essayer de la convertir mais cela ne fonctionne pas.
Merci
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
42
très utile, j'embarque merci ;)
Messages postés
251
Date d'inscription
lundi 29 mars 2004
Statut
Membre
Dernière intervention
4 mars 2008
1
Salut !

OK merci pour l'info Renfield.

Cordialement,
Cacophrène
Afficher les 8 commentaires

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.