1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. GetUnique - Génération d'un nom de fichier auto-incrémenté

GetUnique - Génération d'un nom de fichier auto-incrémenté

Soyez le premier à donner votre avis sur cette source.

Snippet vu 8 530 fois - Téléchargée 8 fois

Commenter

Contenu du snippet 

Private Declare Function GetFileAttributes Lib "kernel32.dll" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Const INVALID_FILE_ATTRIBUTES As Long = &HFFFFFFFF
Public Type PathType
   Folder As String '# Inclue le '\' final
   FileName As String
   FileExt As String '# Inclue le '.'
End Type
'# Permet de découper un chemin en dossier / nom de fichier / extension
Public Function CrackPath(ByVal vsInput As String) As PathType
Dim nPos As Long
   If LenB(vsInput) Then
       nPos = InStrRev(vsInput, "\")
       If nPos Then
           CrackPath.Folder = Left$(vsInput, nPos)
           vsInput = Mid$(vsInput, nPos + 1)
       End If
       
       nPos = InStrRev(vsInput, ".")
       If nPos Then
           CrackPath.FileExt = Mid$(vsInput, nPos)
           CrackPath.FileName = Left$(vsInput, nPos - 1)
       Else
           CrackPath.FileName = vsInput
       End If
   End If
End Function 
'# Permet de tester l'existence d'un fichier (plus fiable que Dir$ qui se plante sur des chemins réseaux manquants
Public Function DoesExists(ByRef vsFilePath 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
   DoesExists = (GetFileAttributes(vsFilePath) <> 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 vsFileName As String, Optional ByRef vsLeftIndicator As String = "(", Optional ByRef vsRightIndicator As String = ")", Optional ByVal vnFirstIndex As Integer = 1) As String
Dim i As Integer
Dim tPath As PathType
Dim Parts(1 To 2) As String
   '# Le fichier existe, on ne se pose pas de question
   If DoesExists(vsFileName) Then
       '# On sépare les parties du nom de fichier
       tPath = CrackPath(vsFileName)
       
       '# Le nom de fichier est séparé en deux parts
       '# 'C:\a(' et ').mp3'
       Parts(1) = tPath.Folder & tPath.FileName & vsLeftIndicator
       Parts(2) = vsRightIndicator & tPath.FileExt
       
       i = vnFirstIndex
       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 DoesExists(GetUnique)
   Else
       GetUnique = vsFileName
   End If
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

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)