Dossier sous dossier fichier
p
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
p
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