Dossier sous dossier fichier

Y compris Power BI, Power Query et toute autre question en lien avec Excel
p
paulo50
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 19 mai 2019
Version d'Excel : 2016 FR

Message par paulo50 » 2 juillet 2019, 13:45

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
Avatar du membre
Xmenpl
Membre impliqué
Membre impliqué
Messages : 2'679
Appréciations reçues : 185
Inscrit le : 16 mai 2018
Version d'Excel : 2003 à 2013

Message par Xmenpl » 2 juillet 2019, 13:55

paulo50 a écrit :
2 juillet 2019, 13:45
reconstruire arborescence ailleurs
Bonjour, pour moi c'est du chinois. un exemple plus clair serait bien mieux qu'un bout de code. ::(
p
paulo50
Jeune membre
Jeune membre
Messages : 12
Inscrit le : 19 mai 2019
Version d'Excel : 2016 FR

Message par paulo50 » 2 juillet 2019, 14:43

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message