Script, Dossier + Sous Dossier + "publication" page HTML

Script, Dossier + Sous Dossier + "publication" page HTML - VB/VBA/VBS - Programmation

Marsh Posté le 18-05-2011 à 11:08:12    

Bonjours,
Dans ce joli petit script il me selectionne tous les sous dossier alors que je souhaiterais m'arreter à 2 si vous avez une idée pour m'aider !!
 

Code :
  1. Dim ShellO: Set ShellO = CreateObject("WScript.Shell" )
  2. Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject" )
  3. Dim SListe: Dim Schemin
  4. 'Dossier à traiter
  5. Schemin = "C:\" 'Dossier à modifier
  6. 'Dossier Bureau de windows + "\"
  7. SListe = ShellO.SpecialFolders("Desktop" )
  8. If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
  9. 'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
  10. Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.html", 1, True)
  12. strHTML=strHTML &"<center><h2><B><font color=red>Liste des Dossiers et Sous-Dossiers dans C:\ </font></B></h2></center>" & _
  13.               "<table border='3' cellpadding='10' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
  14.               "<tr><td><strong>Chemin des Dossiers :</strong></td></tr>"
  15. 'Fichier.WriteLine (Schemin & "<br>" )    
  16. Fichier.WriteLine strHTML 'Ecrire la structure du Tableau en HTML
  17. ListerDossier Schemin, Fichier 'Remplissage dynamique des données dans le Tableau
  18. Fichier.WriteLine "</table>" 'ici on ferme notre tableau par la balise </table>
  19. 'Fermeture du fichier contenant l'arborescence du répertoire à traiter
  20. Fichier.Close
  22. Function ListerDossier(Schemin, Fichier) 'Lister l'arborescence du dossier
  23. On Error Resume Next
  24. Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject" )
  25. Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) 'dossier
  26. Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
  27. Dim ObjSubRepItem
  28. For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossiers
  29. Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a></td></tr>" ) 'Ecrire le path dans les lignes du Tableau en HTML
  30. ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
  31. Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
  32. Next
  33. End Function


 
MERCI A VOUS

Message cité 1 fois
Reply

Marsh Posté le 18-05-2011 à 11:08:12   

Reply

Marsh Posté le 18-05-2011 à 14:51:24    

Salut,c'est du VBA Excel mais facilement adaptable voir sur http://boisgontierjacques.free.fr/ [...] rtoire.htm
 
sinon j'ai posté un VBA Excel sur http://cjoint.com/?3Espcim1hJG


Message édité par kiki29 le 18-05-2011 à 15:02:49
Reply

Marsh Posté le 18-05-2011 à 16:20:12    

Merci de ta participation mais je suis etudiant & trés débutant dans ce language xD
 
je comprend pas les manips

Reply

Marsh Posté le 19-05-2011 à 21:39:37    

Alexis_28 a écrit :

Bonjours,
Dans ce joli petit script il me selectionne tous les sous dossier alors que je souhaiterais m'arreter à 2 si vous avez une idée pour m'aider !!

 
Code :
  1. Dim ShellO: Set ShellO = CreateObject("WScript.Shell" )
  2. Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject" )
  3. Dim SListe: Dim Schemin
  4. Dim level As Integer
  5. level = 0
  6. 'Dossier à traiter
  7. Schemin = "C:\" 'Dossier à modifier
  8. 'Dossier Bureau de windows + "\"
  9. SListe = ShellO.SpecialFolders("Desktop" )
  10. If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
  11. 'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
  12. Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.html", 1, True)
  14. strHTML=strHTML &"<center><h2><B><font color=red>Liste des Dossiers et Sous-Dossiers dans C:\ </font></B></h2></center>" & _
  15.               "<table border='3' cellpadding='10' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
  16.               "<tr><td><strong>Chemin des Dossiers :</strong></td></tr>"
  17. 'Fichier.WriteLine (Schemin & "<br>" )    
  18. Fichier.WriteLine strHTML 'Ecrire la structure du Tableau en HTML
  19. ListerDossier Schemin, Fichier, level 'Remplissage dynamique des données dans le Tableau
  20. Fichier.WriteLine "</table>" 'ici on ferme notre tableau par la balise </table>
  21. 'Fermeture du fichier contenant l'arborescence du répertoire à traiter
  22. Fichier.Close
  24. Function ListerDossier(Schemin, Fichier, ByVal level As Integer) 'Lister l'arborescence du dossier
  25. On Error Resume Next
  26. level = level + 1
  27.     If level > 2 Then
  28.         Exit Function
  29.     End If
  30. Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject" )
  31. Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) 'dossier
  32. Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
  33. Dim ObjSubRepItem
  34. For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossiers
  35. Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a></td></tr>" ) 'Ecrire le path dans les lignes du Tableau en HTML
  36. ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
  37. ListerDossier ObjSubRepItem.Path, Fichier, level 'traiter les sous-dossiers
  38. Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
  39. Next
  40. End Function
 

MERCI A VOUS

 

Bonjour, si j'ai bien compris tu veux t'arrêter à un niveau 2 dans les sous-dossier.
En rouge tu as un appel de la fonction ListerDossier par elle-même (récursivité).
Si tu veux t'arrêter au niveau 2 il faut ajouter une sortie dans cette fonction quand elle atteint le niveau 2. Voir ajout en bleu.
Et en vert le nom du dossier est en fixe dans le code html alors que ton dossier est en dynamique...


Message édité par tarteflambee le 19-05-2011 à 21:42:24
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed