Navigation en cascade dans des répertoires / sous répertoire

[_ledude_]

Bonjour,j'ai un grand nombre de fichiers à inclure dans une base.Comme cette action risque de se répéter, j'ai créé un agent qui me balaye un répertoire donné pour récupérer tous les fichiers contenus dans ce répertoire.Voici mon script Sub Initialize Dim ws As New NotesUIWorkspace Dim session As New NotesSession Dim db As NotesDataBase Dim doc As NotesDocument Dim fn As Variant Dim success As Variant Dim strExtension As String Dim strNomElement As String Dim pathName As String Dim fileName As String Dim Rep As String Dim pos As Integer Set db = session.CurrentDataBase 'Récupération du répertoire à analyser fn = ws.SaveFileDialog( True, "Répertoire racine", "" ) Forall file In fn Rep = file End Forall pathName$ = Rep & "\*.*" fileName$ = Dir$(pathName$, 0) 'On navigue dans le répertoire afin de récupérer tous les fichiers contenu Do While fileName$ <> "" 'Récupération du nom de l'élément ainsi que de son extension pos = Instr(fileName$, ".") strNomElement = Left(fileName$, pos-1) strExtension = Right(fileName$, Len(fileName$) - pos + 1) 'Création du document stockant l'élément externe Set doc = New NotesDocument(db) doc.Form = "Image" doc.Intitule = strNomElement doc.fileext = strExtension doc.Chemin = Rep & "\" & fileName$ 'Attachement de l'élément externe Dim rtitem As Variant Dim object As NotesEmbeddedObject Set rtitem = New NotesRichTextItem ( doc, "Image" ) Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", Rep & "\" & fileName$) success = doc.ComputeWithForm(True,False) Call doc.Save(True,False) 'Récupération du fichier suivant fileName$ = Dir$() Loop End SubCe script fonctionne parfaitement pour "scanner" un répertoire donné.Est il possible de le modifier afin de pouvoir naviguer en cascade parmis plusieurs dossiers et sous dossiers?J'ai pour l'instant effectué plusieurs tests, tous infructueux!.En espérant que quelqu'un ait une réponse...Dude

[Sylvain]

J'ai pas trop le temps de te pondre le code mais c'est le cas typique pour appliquer un peu de récursivité. En gros il faut que tu fasses une fonction qui te retourne le contenu d'un répertoire donné. Puis que ta fonction s'appele elle même temps qu'il existe des sous répertoires. function getListRepertoire(repertoire, listeFichier) boucle scan du reportoire ligne par ligne si on trouve un fichier on l'ajoute à la liste : listeFichier = listeFichier + fichier trouvé si on trouve un repertoire on rappel la fonction avec le nom du repertoire en paramètre : getLstRepertoire(repertoire, listeFichier) on passe à la ligne suivante fin boucle scan du repertoire end function Le récursif c'est super puissant... mais ça peu devenir tres vite prise de tete à débugger [%sig%]

[_ledude_]

c'est ce que j'avais commencer à faire mais j'obtiens une erreur lorsque je veux passer à mon répertoire suivant.Je suis pas encore très au point avec cet aspect là du LS (Dir$(), ...) mais je vais bien réussir à bidouiller un truc!!!Merci pour ta réponse, maintenant je sais que c'est possible, donc je devrais pouvoir m'en sortir.Si je m'englue trop, vous aurez droit un autre petit appel au secour...Dude

[Sylvain]

Pas de pb.Bon courage.[%sig%]

[oguruma]

bon voici un exemple de code....en fait la fonction dir$(...) est assez capricieuse en effet... on ne pas faire du récursif de chez récursif car quand on la quitte un petit moment... bennn on perd le pointeur sur lequel on était... cette petite farce si j'ai bonne mémoire n'est pas uniquement liée au LS(Notes) mais aussi au VB et ses dérivés.Par conséquent, il faut d'abord identifier tous les sous-répertoires d'un répertoire et les mémoriser dans un tableau.Puis ensuite dans ce répertoire faire uniquement le scan des fichiers, dès que le scan des fichiers est effectuée on scan à nouveau et un à un les répertoires identifiés... et boucle de manière récursive jusqu'au dernier répertoire du premier tableau initialisé, bon ça paraît un peu sioux...j'ai repris un de mes codes que j'ai adaptés pour l'exemple... tu peux t'en inspirer pour l'insérer dans ton application.y a peut-être plus propre... je ne m'y suis trop attardé à l'époque, il fallait faire vite chez le client alors pour l'algorithmique... j'ai fait le plus simpe...exemple d'appel : ok=scanDirectory("c:\alpha","*.*")Function scanDirectory( path As String, mask As String) As Integer Dim listDir() As String Dim nbDir As Integer Dim fileName As String Dim dirName As String Dim attrib As Integer Dim pathName As String Dim newPathName As String Dim ok As Integer Dim n As Integer On Error Goto handleError nbDir=0 Redim listDir(0) pathname=path+"\"+mask dirName = Dir$(pathname,16) '// on recherche en premier les répertoires Do While dirName <> "" If dirname<>"." And dirname<>".." Then attrib = Getfileattr(path+"\"+dirName) If attrib=16 Then newpathName=path+"\"+dirName listDir(nbDir)=newPathName nbDir=Nbdir+1 Redim Preserve listDir(nbDir) Print "Directory : ";dirname End If End If dirName = Dir$() Loop '// Maintenant on analyse les fichiers du repertoire fileName = Dir$(pathname,6) Do While fileName <> "" Print pathname+"\"+fileName fileName = Dir$() Loop '// on analyse les directory détectées For n=0 To Ubound(listDir) -1 ok=scanDirectory( listDir(n), mask ) Next scanDirectory=True Exit FunctionhandleError: Messagebox "Erreur n ° " & Err & " - " & Error$ & " ligne " & Erl,16,"Scan Directory" Resume finfin: scanDirectory=FalseEnd Function

[oguruma]

fileName = Dir$(pathname,6) tu peux aussi faire un fileName = Dir$(pathname,0) -- ici je prends en plus les fichiers system et hidden

[_ledude_]

Merci pour tes réponses oguruma.Je vais essayer de mettre tout ça en oeuvre...

[oguruma]

Bon attention... j'ai modifié cette proc hier soir (cette nuit vite fait) il se peut qu'il y ait une petite coquille... fatigue... mais l'essentiel y est en ce qui concerne la manière de faire

[_ledude_]

si l'esprit est là, je devrais pouvoir corriger une éventuelle coquille.En fait j'avais commencé à corriger mon script en stockant effectivement les noms de répertoires dans un tableau puis en me baladant ensuite à travers les répertoires avec ChDir "MonRep".Mais je me suis un peu emmellé les pinceaux, j'avais du mal à bien manier le Dir$() et le ChDir donc j'ai laissé reposer un peu avant de m'y remettre.En plus apparremment ce n'était pas la bonne méthode.Bon, je m'y replonge...

[oguruma]

en effet chdir n'est pas la solution, il faut construire ton répertoire en concaténation, car lorsque tu fais chdir il faut se souvenir du répertoire de d'où tu viens... pour reprendre de où tu viens...

[Sylvain]

Si vraiment tu t'en sort pas, tu as toujours la possibilité d'utiliser une bonne vielle commande dos : dir /s repertoireTu la lances avec un shell et tu rediriges l'affichage vers un fichier texte qu'il te suffit ensuite de lire.dir /s repertoire > liste.txt... c'est d'la bidouille, mais je l'ai déja fait, en cas d'extreme urgence [%sig%]

[_ledude_]

Ben en fait je viens de m'en sortir.Voici donc mon script final (merci oguruma pour la charnière centrale).A partir d'un répertoire racine, je récupère tous les fichiers contenus dans ce répertoire ainsi que dans ses sous répertoires.Pour chaque fichier trouvé, je crée un document le stockant. Le nom du sous répertoire me servant à catégoriser le document en question.Bien sûr c'est améliorable...Voici le synopsis de l'agentSynopsis de base de documents Lotus Notes - créé à 11:04:23 le 10/02/2004Informations d'agentNom : Import des objets externesDernière modification : 10/02/2004 11:01:59Commentaire : [Sans]Agent partagé : OuiType : LotusScriptEtat : Activé(e)Déclencher : Lorsque vous le sélectionnez dans le menu Actions.S'applique à : Exécuter une fois (commandes @ autorisées)Code LotusScript :Option PublicOption DeclareSub Initialize Dim ws As New NotesUIWorkspace Dim session As New NotesSession Dim db As NotesDataBase Dim result As Variant Dim fn As Variant Dim Rep As String Dim pos As Integer On Error Goto GestErr Set db = session.CurrentDataBase 'Récupération du répertoire racine fn = ws.SaveFileDialog( True, "Répertoire racine", "" ) Forall file In fn Rep = file End Forall 'On scanne le répertoire source result = scanDirectory(Rep,"*.*", db) Exit Sub GestErr: Messagebox "Base : " & db.Title & " - Agent <Import des objets externes> - Procédure <Initialize> : Erreur " & Cstr(Err) & " " & Error$ & " à la ligne " & Cstr(Erl) Exit Sub End SubFunction scanDirectory( path As String, mask As String, db As NotesDataBase) As Integer'On navigue à travers le répertoire donné pour récupérer tous les sous dossiers ainsi que les fichiers'Pour chaque sous dossier trouvé, on exécute à nouveau la fonction'Pour chaque fichier trouvé, on crée un document qui stocke le dit fichier Dim listDir() As String Dim nbDir As Integer Dim fileName As String Dim dirName As String Dim attrib As Integer Dim pathName As String Dim newPathName As String Dim ok As Integer Dim n As Integer On Error Goto handleError nbDir=0 Redim listDir(0) pathname=path+"\"+mask dirName = Dir$(pathname,16) '// on recherche en premier les répertoires Do While dirName <> "" If dirname<>"." And dirname<>".." Then attrib = Getfileattr(path+"\"+dirName) If attrib=16 Then newpathName=path+"\"+dirName listDir(nbDir)=newPathName nbDir=Nbdir+1 Redim Preserve listDir(nbDir) Print "Directory : ";dirname End If End If dirName = Dir$() Loop '// Maintenant on analyse les fichiers du repertoire fileName = Dir$(pathname,6) Do While fileName <> "" Print pathname+"\"+fileName'On crée un document qui stocke le fichier trouvé Call creeDoc(path, fileName, db) fileName = Dir$() Loop '// on analyse les directory détectées For n=0 To Ubound(listDir) -1 ok=scanDirectory( listDir(n), mask, db) Next scanDirectory=True Exit Function handleError: Messagebox "Base : " & db.Title & " - Agent <Import des objets externes> - Fonction <scanDirectory> : Erreur n ° " & Err & " - " & Error$ & " ligne " & Erl,16,"Scan Directory" Resume fin fin: scanDirectory=False End FunctionFunction creeDoc(NomRep As String, NomFich As String, db As NotesDataBase)'Création d'un document stockant le fichier trouvé'Le nom du répertoire contenant ce fichier est utilisé comme catégorie'Le nom du fichier comme titre de document Dim doc As NotesDocument Dim strNomElement As String Dim Rep As String strNomElement = Strleftback(NomFich, ".") Rep = Strrightback(NomRep, "\") 'Création du document stockant l'élément externe Set doc = New NotesDocument(db) doc.Form = "m_theme" doc.SubJect = Format(Now(), "dd/mm/yyyy") & " - " & strNomElement doc.Categories = Remplace(Rep, "=", ":") doc.SubCat = "10 - Fichier Externe" doc.LastCat = "- Aucune -" doc.d_coauteurs = "MrX" 'Attachement de l'élément externe Dim rtitem As Variant Dim object As NotesEmbeddedObject Set rtitem = New NotesRichTextItem ( doc, "Body" ) Set object = rtitem.EmbedObject ( EMBED_ATTACHMENT, "", NomRep & "\" & NomFich) Call doc.ComputeWithForm(True,False) Call doc.Save(True,False) Exit FunctionGestErr: Messagebox "Base : " & db.Title & " - Agent <Import des objets externes> - Fonction <CreeDoc> : Erreur " & Cstr(Err) & " " & Error$ & " à la ligne " & Cstr(Erl) Exit FunctionEnd FunctionFunction Remplace(strEntree As String, car1 As String, car2 As String) As String Dim strChaine As String Dim intCar As Integer strChaine = strEntree While Not Instr(strChaine , car1) = 0 intCar = Instr(strChaine , car1) strChaine = Mid(strChaine, 1, intCar-1) & car2 & Mid(strChaine, intCar+Len(car1)) Wend Remplace = strChaineEnd Function OOUUFFFFFFFF, voilà une bonne chose de faite......Dude

[oguruma]

ben voilà... c'est hyper propre en plus, bon boulot !pour faire super clean, tu peux supprimer les print intermédiaires dans le scan... ça va accélérer le traitement et si l'agent fonctionne de nuit de manière programmée ça va allègé ton fichier log !"affaire suivante..." comme on dit !

[_ledude_]

avant l'affaire suivante, vais aller courrir un peu...La tête a travaillé ce matin, elle a le droit de se reposer ce midi pendant que le corps prend le relai.En tout cas merci bcp pour ton aide précieuse.