Dossier sous dossier fichier

bonjour je cherche comment extraire juste le dossier sous-dossier fichier

actuellement j’utilise fichier.Path le problème c'est que sa récupère tout le chemin du fichier alors que je cherche juste la parti au niveau du dossier sélectionner pour pouvoir reconstruire arborescence ailleurs

Sub import_txt()
    Dim Repertoire As FileDialog, monRepertoire As String
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    If Repertoire.SelectedItems.Count > 0 Then
        monRepertoire = Repertoire.SelectedItems(1)
        aspirer monRepertoire
    Else
        MsgBox "Aucun Répertoire Sélectionné"
    End If
End Sub
Sub aspirer(ceRepertoire As String)
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Dim adoStream As ADODB.Stream
    Dim var_String As Variant
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(ceRepertoire)

    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If Right(fichier.Name, 4) = ".txt" Then

        'variable*
        lr = Sheets("texte").Range("a" & Rows.Count).End(xlUp).Row
        ld = lr + 5

        'ecriture du fichier
            Set adoStream = New ADODB.Stream
            adoStream.Charset = "UTF-8"
            adoStream.Open
            adoStream.LoadFromFile fichier.Path
            var_String = Split(adoStream.ReadText, vbCrLf) 'split entire file into array - lines delimited by CRLF
            Range("a" & lr + 5).Resize(UBound(var_String) - LBound(var_String)).Value = Application.Transpose(var_String) 'output array to activesheet.
            lf = Sheets("texte").Range("a" & Rows.Count).End(xlUp).Row
            'ecriture info
            Sheets("texte").Cells(lr + 2, 1) = fichier.Path 'a changer
            Sheets("texte").Cells(lr + 3, 1) = ld
            Sheets("texte").Cells(lr + 4, 1) = lf

   'dos = file.Name + fichier.Name

        End If
    Next fichier

    ' appel récursif pour les sous-répertoires
    For Each SubFolder In SourceFolder.SubFolders
        aspirer SubFolder.Path
    Next SubFolder

End Sub

reconstruire arborescence ailleurs

Bonjour, pour moi c'est du chinois. un exemple plus clair serait bien mieux qu'un bout de code.

quand je sélectionne Nouveau dossier avec FileDialog(msoFileDialogFolderPicker)

actuellement sa me récupère ça X:\testmacro\Nouveau dossier\785\06_Day1Night_Investigate.txt

il me faudrait une variable pour récupérer ça Nouveau dossier\785\06_Day1Night_Investigate.txt

Rechercher des sujets similaires à "dossier fichier"