Ce module va chercher n'importe quel nom du répertoire dans une chemin. Vous pouvez aussi sortir seulement l'extension du fichier dans le chemin, le nom du fichier plus son extension ou sans et même le backslash suivie du nom de fichier avec ou sans extension.
Source / Exemple :
Attribute VB_Name = "ModuleChemin"
Option Explicit
Dim a(20) As Integer ' Nombre de sous-répertoire maximum
Dim B As Integer ' Numéro de chaque BackSlash dans le chemin
Dim X As Integer ' Numéro du caractère dans le chemin
Dim Y As Integer ' Numéro du point
Public Function Chemin(Texte As String, Debut As Integer, Fin As Integer, backslash As Boolean) As String
B = 0 'Initialise la variable B pour une nouvelle passe
'Vérifie combien de répertoire dans le chemin
For X = 1 To Len(Texte)
If Mid(Texte, X, 1) = "\" Then
B = B + 1
a(B) = X
Form1.ListNumero.AddItem B & "=" & a(B) 'Seulement pour le démo
End If
Next X
'Vérifie les entrées erronées
If Fin < 1 Or Fin > B Then
MsgBox "Fin erronée"
Exit Function
End If
If Debut < 0 Or Debut > B Or Debut >= Fin Then
MsgBox "Debut erronée"
Exit Function
End If
'Si le debut est le root
If Debut = 0 Then
Chemin = Left(Texte, a(Fin) - 1)
If backslash Then Chemin = Left(Texte, a(Fin))
Exit Function
End If
'Si le debut est autre que le root
Chemin = Mid(Texte, a(Debut), a(Fin) - (a(Debut)))
If backslash Then Chemin = Mid(Texte, a(Debut), a(Fin) - (a(Debut) - 1))
End Function
Public Function Fichier(Nom As String, backslash As Boolean, Point As Boolean, Ext As Boolean) As String
B = 0 'Initialise la variable B pour une nouvelle passe
'Vérifie ou est le point dans le chemin
For X = Len(Nom) To 1 Step -1
If Mid(Nom, X, 1) = "." Then Y = X
If Mid(Nom, X, 1) = "\" Then
B = X
Exit For
End If
Next X
'Si juste l'extension est choisi
If Ext = True And Point = False Then
Fichier = Mid(Nom, Y + 1, Len(Nom) - Y)
Exit Function
End If
'Si le point et l'extension sont choisi
If Point And Ext Then
Fichier = Mid(Nom, B + 1, Len(Nom))
If backslash Then Fichier = Mid(Nom, B, Len(Nom))
Exit Function
End If
'Si le seulement le point est choisi
If Point Then
Fichier = Mid(Nom, B + 1, Y - B)
If backslash Then Fichier = Mid(Nom, B, Y - B + 1)
Exit Function
End If
'Si seulement le nom du fichier est choisi
Fichier = Mid(Nom, B + 1, Y - (B + 1))
If backslash Then Fichier = Mid(Nom, B, Y - (B))
End Function
Public Function Remonte(Repertoire As String, Rep As Integer, backslash As Boolean) As String
Dim DernierRep As Integer
B = 0 'Initialise la variable B pour une nouvelle passe
'Vérifie combien de répertoire dans le chemin
For X = 1 To Len(Repertoire)
If Mid(Repertoire, X, 1) = "\" Then
B = B + 1
a(B) = X
Form1.ListNumero.AddItem B & "=" & a(B) 'Seulement pour le démo
End If
Next X
DernierRep = B
'Vérifie les entrées erronées
If Rep < 1 Or Rep > (B - 1) Then
MsgBox "Rep erronée"
Exit Function
End If
'Retourne
Remonte = Mid(Repertoire, a(B - Rep), a(B) - a(B - Rep))
If backslash Then Remonte = Mid(Repertoire, a(B - Rep), a(B) - a(B - Rep) + 1)
End Function
Conclusion :
Voir le ZIP pour une démonstration. J'attend vos 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.