Sur un disque dur, j'ai un répertoire appelé Base.
Dans ce répertoire, j'ai x sous-répertoires.
Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de
rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair.
Je suis parti de la proc. de MichDenis, mais elle liste tous les
répertoires.
Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:\Base
If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit
Sub
Ligne = 13
Set fso = CreateObject("Scripting.FileSystemObject")
'Set dossier_racine = fso.GetFolder("H:\Base")
Set dossier_racine = fso.getfolder(Path)
Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 7) = dossier.Path
'Cells(Ligne, 7) = dossier.Name
Bonjour. Va voir la la macro de Denis Michon ici : http://www.excelabo.net/trucs/fichiers_et_tailles à aménager suivant tes besoins. Daniel
Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
If Dir(dossier.Path, vbDirectory) <> "*_TS" Then Cells(Ligne, 7) = "" 'If Dir(dossier.Path, vbDirectory) = "*_TS" Then GoTo p1
'p1: For Each d In dossier.subfolders Lit_dossier_DVD d Next
End Sub
Merci par avance pour vos éclairages.
Cordialement
Infogroup
Bonjour.
Va voir la la macro de Denis Michon ici :
http://www.excelabo.net/trucs/fichiers_et_tailles
à aménager suivant tes besoins.
Daniel
Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base.
Dans ce répertoire, j'ai x sous-répertoires.
Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de
rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair.
Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires.
Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base
If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit
Sub
Ligne = 13
Set fso = CreateObject("Scripting.FileSystemObject")
'Set dossier_racine = fso.GetFolder("H:Base")
Set dossier_racine = fso.getfolder(Path)
Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 7) = dossier.Path
'Cells(Ligne, 7) = dossier.Name
Bonjour. Va voir la la macro de Denis Michon ici : http://www.excelabo.net/trucs/fichiers_et_tailles à aménager suivant tes besoins. Daniel
Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
If Dir(dossier.Path, vbDirectory) <> "*_TS" Then Cells(Ligne, 7) = "" 'If Dir(dossier.Path, vbDirectory) = "*_TS" Then GoTo p1
'p1: For Each d In dossier.subfolders Lit_dossier_DVD d Next
End Sub
Merci par avance pour vos éclairages.
Cordialement
Infogroup
michdenis
Bonjour,
Essaie ceci :
Tu places tout ce qui suit dans un module standard. Tu définis dans la procédure "test" le répertoire que tu veux analyser Et tu m'envoies ton chèque ! ;-) '------------------------------------------------ Sub test() Dim Répertoire As String, MaListe Dim Temp(), Elt As Variant, A As Integer Dim Sh As Worksheet
'Répertoire de départ à définir... Répertoire = "C:UsersDM"
On Error Resume Next Application.ScreenUpdating = False If Dir(Répertoire, vbDirectory) <> "" Then Set Sh = Worksheets.Add MaListe = ListeDossiers(Répertoire, Temp()) With Sh For Each Elt In MaListe A = A + 1 .Range("A" & A) = Répertoire & "" & Elt x = ListeDossiers(Répertoire & "" & Elt, Temp()) .Range("B" & A).Resize(UBound(x) + 1) = _ Application.Transpose(x) A = A + UBound(x) Next .Range("A:B").EntireColumn.AutoFit = True End With End If Application.ScreenUpdating = True End Sub '---------------------------------------- Function ListeDossiers(dossier, Liste()) Dim Fs As Object, F As Object Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(dossier) Set Sf = F.SubFolders
For Each F1 In Sf ReDim Preserve Liste(0 To A) Liste(A) = F1.Name A = A + 1 Next ListeDossiers = Liste
End Function '----------------------------------------
"Infogroup" a écrit dans le message de groupe de discussion : Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
If Dir(dossier.Path, vbDirectory) <> "*_TS" Then Cells(Ligne, 7) = "" 'If Dir(dossier.Path, vbDirectory) = "*_TS" Then GoTo p1
'p1: For Each d In dossier.subfolders Lit_dossier_DVD d Next
End Sub
Merci par avance pour vos éclairages.
Cordialement
Infogroup
Bonjour,
Essaie ceci :
Tu places tout ce qui suit dans un module standard.
Tu définis dans la procédure "test" le répertoire que
tu veux analyser
Et tu m'envoies ton chèque ! ;-)
'------------------------------------------------
Sub test()
Dim Répertoire As String, MaListe
Dim Temp(), Elt As Variant, A As Integer
Dim Sh As Worksheet
'Répertoire de départ à définir...
Répertoire = "C:UsersDM"
On Error Resume Next
Application.ScreenUpdating = False
If Dir(Répertoire, vbDirectory) <> "" Then
Set Sh = Worksheets.Add
MaListe = ListeDossiers(Répertoire, Temp())
With Sh
For Each Elt In MaListe
A = A + 1
.Range("A" & A) = Répertoire & "" & Elt
x = ListeDossiers(Répertoire & "" & Elt, Temp())
.Range("B" & A).Resize(UBound(x) + 1) = _
Application.Transpose(x)
A = A + UBound(x)
Next
.Range("A:B").EntireColumn.AutoFit = True
End With
End If
Application.ScreenUpdating = True
End Sub
'----------------------------------------
Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders
For Each F1 In Sf
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
Next
ListeDossiers = Liste
End Function
'----------------------------------------
"Infogroup" <regennasbernard@hotmail.com> a écrit dans le message de groupe de discussion
: eVbqzVusKHA.4816@TK2MSFTNGP02.phx.gbl...
Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base.
Dans ce répertoire, j'ai x sous-répertoires.
Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de
rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair.
Je suis parti de la proc. de MichDenis, mais elle liste tous les
répertoires.
Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base
If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit
Sub
Ligne = 13
Set fso = CreateObject("Scripting.FileSystemObject")
'Set dossier_racine = fso.GetFolder("H:Base")
Set dossier_racine = fso.getfolder(Path)
Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 7) = dossier.Path
'Cells(Ligne, 7) = dossier.Name
Tu places tout ce qui suit dans un module standard. Tu définis dans la procédure "test" le répertoire que tu veux analyser Et tu m'envoies ton chèque ! ;-) '------------------------------------------------ Sub test() Dim Répertoire As String, MaListe Dim Temp(), Elt As Variant, A As Integer Dim Sh As Worksheet
'Répertoire de départ à définir... Répertoire = "C:UsersDM"
On Error Resume Next Application.ScreenUpdating = False If Dir(Répertoire, vbDirectory) <> "" Then Set Sh = Worksheets.Add MaListe = ListeDossiers(Répertoire, Temp()) With Sh For Each Elt In MaListe A = A + 1 .Range("A" & A) = Répertoire & "" & Elt x = ListeDossiers(Répertoire & "" & Elt, Temp()) .Range("B" & A).Resize(UBound(x) + 1) = _ Application.Transpose(x) A = A + UBound(x) Next .Range("A:B").EntireColumn.AutoFit = True End With End If Application.ScreenUpdating = True End Sub '---------------------------------------- Function ListeDossiers(dossier, Liste()) Dim Fs As Object, F As Object Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(dossier) Set Sf = F.SubFolders
For Each F1 In Sf ReDim Preserve Liste(0 To A) Liste(A) = F1.Name A = A + 1 Next ListeDossiers = Liste
End Function '----------------------------------------
"Infogroup" a écrit dans le message de groupe de discussion : Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répertoires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
michdenis
Bonjour,
Tu places tout ce qui suit dans un module standard. Tu définis dans la procédure "test" le répertoire que tu veux analyser Et tu m'envoies ton chèque ! ;-) (Message précédent annulé - utilise ceci) '----------------------------------------- Sub test() Dim Répertoire As String, MaListe Dim Temp(), Elt As Variant, A As Integer Dim Sh As Worksheet
'Répertoire de départ à définir... Répertoire = "C:UsersDM"
On Error Resume Next Application.ScreenUpdating = False If Dir(Répertoire, vbDirectory) <> "" Then Set Sh = Worksheets.Add MaListe = ListeDossiers(Répertoire, Temp()) Erase Temp With Sh For Each Elt In MaListe A = A + 1 .Range("A" & A) = Répertoire & "" & Elt x = ListeDossiers(Répertoire & "" & Elt, Temp()) .Range("B" & A).Resize(UBound(x) + 1) = _ Application.Transpose(x) A = A + UBound(x) Next .Range("A:B").EntireColumn.AutoFit = True End With End If Application.ScreenUpdating = True End Sub '----------------------------------------- Function ListeDossiers(dossier, Liste()) Dim Fs As Object, F As Object Dim F1 As Object, Sf As Object, A As Integer Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(dossier) Set Sf = F.SubFolders
For Each F1 In Sf ReDim Preserve Liste(0 To A) Liste(A) = F1.Name A = A + 1 Next ListeDossiers = Liste Erase Liste End Function '-----------------------------------------
Bonjour,
Tu places tout ce qui suit dans un module standard.
Tu définis dans la procédure "test" le répertoire que
tu veux analyser
Et tu m'envoies ton chèque ! ;-)
(Message précédent annulé - utilise ceci)
'-----------------------------------------
Sub test()
Dim Répertoire As String, MaListe
Dim Temp(), Elt As Variant, A As Integer
Dim Sh As Worksheet
'Répertoire de départ à définir...
Répertoire = "C:UsersDM"
On Error Resume Next
Application.ScreenUpdating = False
If Dir(Répertoire, vbDirectory) <> "" Then
Set Sh = Worksheets.Add
MaListe = ListeDossiers(Répertoire, Temp())
Erase Temp
With Sh
For Each Elt In MaListe
A = A + 1
.Range("A" & A) = Répertoire & "" & Elt
x = ListeDossiers(Répertoire & "" & Elt, Temp())
.Range("B" & A).Resize(UBound(x) + 1) = _
Application.Transpose(x)
A = A + UBound(x)
Next
.Range("A:B").EntireColumn.AutoFit = True
End With
End If
Application.ScreenUpdating = True
End Sub
'-----------------------------------------
Function ListeDossiers(dossier, Liste())
Dim Fs As Object, F As Object
Dim F1 As Object, Sf As Object, A As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set F = Fs.GetFolder(dossier)
Set Sf = F.SubFolders
For Each F1 In Sf
ReDim Preserve Liste(0 To A)
Liste(A) = F1.Name
A = A + 1
Next
ListeDossiers = Liste
Erase Liste
End Function
'-----------------------------------------
Tu places tout ce qui suit dans un module standard. Tu définis dans la procédure "test" le répertoire que tu veux analyser Et tu m'envoies ton chèque ! ;-) (Message précédent annulé - utilise ceci) '----------------------------------------- Sub test() Dim Répertoire As String, MaListe Dim Temp(), Elt As Variant, A As Integer Dim Sh As Worksheet
'Répertoire de départ à définir... Répertoire = "C:UsersDM"
On Error Resume Next Application.ScreenUpdating = False If Dir(Répertoire, vbDirectory) <> "" Then Set Sh = Worksheets.Add MaListe = ListeDossiers(Répertoire, Temp()) Erase Temp With Sh For Each Elt In MaListe A = A + 1 .Range("A" & A) = Répertoire & "" & Elt x = ListeDossiers(Répertoire & "" & Elt, Temp()) .Range("B" & A).Resize(UBound(x) + 1) = _ Application.Transpose(x) A = A + UBound(x) Next .Range("A:B").EntireColumn.AutoFit = True End With End If Application.ScreenUpdating = True End Sub '----------------------------------------- Function ListeDossiers(dossier, Liste()) Dim Fs As Object, F As Object Dim F1 As Object, Sf As Object, A As Integer Set Fs = CreateObject("Scripting.FileSystemObject") Set F = Fs.GetFolder(dossier) Set Sf = F.SubFolders
For Each F1 In Sf ReDim Preserve Liste(0 To A) Liste(A) = F1.Name A = A + 1 Next ListeDossiers = Liste Erase Liste End Function '-----------------------------------------
Daniel.C
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
Je sais pas qui c'est, mais il ya son nom au bas de la macro à
l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum
;-)))
Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ?
Un imposteur ?
;-)
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
Mgr T. Banni
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
il y a, par contre, un dénommé michel qui lui est très assidu
off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause...
jps
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news: u83bHEwsKHA.1796@TK2MSFTNGP02.phx.gbl...
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente
pas le forum ;-)))
Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ?
Un imposteur ?
;-)
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
Daniel.C
;-))) Daniel
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
;-)))
Daniel
il y a, par contre, un dénommé michel qui lui est très assidu
off record : c'est, faut bien le dire, une autre pointure que celui dont à
quoi on cause...
jps
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
u83bHEwsKHA.1796@TK2MSFTNGP02.phx.gbl...
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse
indiquée. Ca doit être un gars qui fréquente pas le forum ;-)))
Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ?
Un imposteur ?
;-)
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répert oires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable ": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
On 21 fév, 12:03, "Infogroup" <regennasbern...@hotmail.com> wrote:
Bonjour à tous,
Sur un disque dur, j'ai un répertoire appelé Base.
Dans ce répertoire, j'ai x sous-répertoires.
Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répert oires de
rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair.
Je suis parti de la proc. de MichDenis, mais elle liste tous les
répertoires.
Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base
If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable ": Exit
Sub
Ligne = 13
Set fso = CreateObject("Scripting.FileSystemObject")
'Set dossier_racine = fso.GetFolder("H:Base")
Set dossier_racine = fso.getfolder(Path)
Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1
Cells(Ligne, 7) = dossier.Path
'Cells(Ligne, 7) = dossier.Name
Sur un disque dur, j'ai un répertoire appelé Base. Dans ce répertoire, j'ai x sous-répertoires. Dans ces x sous-répertoires, j'ai aussi des sous-répertoires etc...
Serait-il, à partir du répertoire Base, de ne lister que les répert oires de rang 1 ou que les répertoires de rang 2 etc...
J'espère avoir été assez clair. Je suis parti de la proc. de MichDenis, mais elle liste tous les répertoires. Pour mémoire, voir ci-dessous.
Public Ligne As Long
Sub ListeDossiers()
Path = H:Base If Dir(Path, vbDirectory) = "" Then MsgBox "Dossier introuvable ": Exit Sub
Ligne = 13 Set fso = CreateObject("Scripting.FileSystemObject") 'Set dossier_racine = fso.GetFolder("H:Base") Set dossier_racine = fso.getfolder(Path) Lit_dossier_DVD dossier_racine
End Sub
Sub Lit_dossier (ByRef dossier)
Ligne = Ligne + 1 Cells(Ligne, 7) = dossier.Path 'Cells(Ligne, 7) = dossier.Name
If Dir(dossier.Path, vbDirectory) <> "*_TS" Then Cells(Ligne, 7) = "" 'If Dir(dossier.Path, vbDirectory) = "*_TS" Then GoTo p1
'p1: For Each d In dossier.subfolders Lit_dossier_DVD d Next
End Sub
Merci par avance pour vos éclairages.
Cordialement
Infogroup
Infogroup
Un grand merci à Daniel.C et michdenis ( je ne dirai pas Denis Michon ! )
C'est OK pour moi
Cordialement
Infogroup
"Daniel.C" a écrit dans le message de groupe de discussion : OkX#
;-))) Daniel
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
Un grand merci à Daniel.C et michdenis ( je ne dirai pas Denis Michon ! )
C'est OK pour moi
Cordialement
Infogroup
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de groupe de
discussion : OkX#iLwsKHA.6004@TK2MSFTNGP04.phx.gbl...
;-)))
Daniel
il y a, par contre, un dénommé michel qui lui est très assidu
off record : c'est, faut bien le dire, une autre pointure que celui dont
à quoi on cause...
jps
"Daniel.C" <dcolardelleZZZ@gmail.com> a écrit dans le message de news:
u83bHEwsKHA.1796@TK2MSFTNGP02.phx.gbl...
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse
indiquée. Ca doit être un gars qui fréquente pas le forum ;-)))
Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ?
Un imposteur ?
;-)
Un grand merci à Daniel.C et michdenis ( je ne dirai pas Denis Michon ! )
C'est OK pour moi
Cordialement
Infogroup
"Daniel.C" a écrit dans le message de groupe de discussion : OkX#
;-))) Daniel
il y a, par contre, un dénommé michel qui lui est très assidu off record : c'est, faut bien le dire, une autre pointure que celui dont à quoi on cause... jps
"Daniel.C" a écrit dans le message de news:
Je sais pas qui c'est, mais il ya son nom au bas de la macro à l'adresse indiquée. Ca doit être un gars qui fréquente pas le forum ;-))) Daniel
Va voir la la macro de Denis Michon ici :
Dis Daniel, tu connais un répondeur sur ce forum sous ce nom ? Un imposteur ? ;-)
michdenis
| Mgr T. Banni | il y a, par contre, un dénommé michel qui lui est très assidu | off record : c'est, faut bien le dire, une autre pointure que | celui dont à quoi on cause...
*** Continuer de diffamer Mgr, c'est moi qui vous le dis ce n'est pas demain que vous serez canonisé! ;-)
| Mgr T. Banni
| il y a, par contre, un dénommé michel qui lui est très assidu
| off record : c'est, faut bien le dire, une autre pointure que
| celui dont à quoi on cause...
*** Continuer de diffamer Mgr, c'est moi qui vous le dis
ce n'est pas demain que vous serez canonisé!
;-)
| Mgr T. Banni | il y a, par contre, un dénommé michel qui lui est très assidu | off record : c'est, faut bien le dire, une autre pointure que | celui dont à quoi on cause...
*** Continuer de diffamer Mgr, c'est moi qui vous le dis ce n'est pas demain que vous serez canonisé! ;-)