Module chemin

Description

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.

Codes Sources

A voir également

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.