choix et exploration répertoire et sous repertoires

Question

Bonjour, 

j'ai constitué une macro pour pouvoir rechercher depuis une liste excel des fichiers dans un lecteur, puis une copie de ces fichiers dans un répertoire en dur

Cette macro fonctionne bien sur le lecteur défini en dur, cependant, j'aurai besoin finalement de pouvoir choisir un répertoire ou un lecteur et que la macro balaye tous les répertoires et sous répertoires (si il y en a) depuis le niveau sélectionné.
Par exemple, si je sélectionne le lecteur D: il faut balayer tous les rep et sous rep dessous, par contre si je sélectionne D:	est, il faut balayer D:	est et tous les sous rep qui seraient inclus.

Ci dessous mon code : 
Sub dupliean()

Dim P As Range, DosSource$, DosDestin$, ext$, c As Range, DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Set P = Range("A1:A" & DernLigne) 'plage avec les noms des fichiers (sans extension)
DosSource = "Z:" 'à adapter
DosDestin = "D:\Test" 'à adapter
ext = ".jpg"
Application.DisplayAlerts = False
On Error Resume Next
MkDir DosDestin 'crée le dossier s'il n'existe pas
For Each c In P
  FileCopy DosSource & c & ext, DosDestin & c & ext
  c(1, 2) = IIf(Dir(DosDestin & c & ext) = "", "", "OK")
Next
MsgBox Application.CountA(P.Offset(, 1)) & " fichiers copiés"
End Sub

J'ai donc besoin de pouvoir choisir DosSource si possible depuis une boite de dialogue type explorer windows

On m'a aidé à créér une fonction :
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
 et du coup dans DosSource, j'ai maintenant = GetFolder("Z:"), mais celà ne va pas dans tous les sous repertoires.

Pouvez vous donc m'aider ?

Merci d'avance

EDIT: Ajout de la coloration syntaxique.


pouloucarine

Whismeril · Answer

Bonjour, merci de penser à la coloration syntaxique, on l'avait déjà mise pour toi la dernière fois.

ucfoutu · Answer

Bonjour, Regarde ce que fait ceci : (n'oublie pas d'ajouter une listbox nommée List1 dans cet exemple Private Sub CommandButton1_Click() Dim filtredossier As String, filtrefichier As String, repertoire_a_fouiller As String repertoire_a_fouiller = "d:\monoutil\" ' tu mets ici ton répertoire à fouiller filtredossier = "modeles" ' tu mets ici le nom de dossier à chercher (si dossier) ' tu mets ensuite le nom de fichier à chercher (si fichier) ... pour toi, ce serait donc 'le même que le nom de dossier, mais avec une extension en plus (tu peux également remlplacer .* ' par .ton_extension, bien entendu filtrefichier = "*.*" List1.Clear fouillons repertoire_a_fouiller, filtredossier, filtrefichierEnd SubSub fouillons(ByVal R As String, FD As String, FF As String) Dim NF As String, NBR As Integer, chemin As String, i As Integer Me.MousePointer = vbHourglass If Right$(R, 1) <> "\" Then R = R & "\" NF = Dir$(R, vbDirectory): NBR = 1 Do While NF <> "" If NF <> "." And NF <> ".." Then chemin = R & NF If GetAttr(chemin) And vbDirectory Then If NF Like FD Then List1.AddItem chemin fouillons chemin, FD, FF NF = Dir$(R, vbDirectory) For i = 2 To NBR NF = Dir$ Next Else If NF Like FF Then List1.AddItem chemin End If End If NF = Dir$: NBR = NBR + 1 Loop Me.MousePointer = vbDefaultEnd Sub Bien entendu : - remplace "D\monoutil\" par TON répertoire (celui que te retourne ton sitem - donne à filtrefichier le filtre que tu souhaites ( ex : "*.*" pour tous, "*.txt" pour les seuls .txt, "*toto*.jpg" pour les seuls .jpg dont le com contient "toto", etc ... Voilà. D'aucuns viendront probablement te parler de l'utilisation (plus simple) de FSO. J'émets par avance de très sérieuses réserves à cette utilisation. Pourquoi ? ===>> parce que finalement plus lourd (en mémoire), d'une part, et, d'autre part et surtout : ne marcherait pas sur certaines machines (dont la mienne) dont le propriétaire a inhibé VBS pour des raisons de sécurité. ________________________ Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches. Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviend

Choix et exploration répertoire et sous repertoires

2 réponses

Votre réponse

Discussions similaires