Sujet Précédent Sujet Suivant

Problème de parcours de Dossiers

Résolu/Fermé
VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016 - Modifié par pijaku le 27/02/2015 à 08:51
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 11 mars 2015 à 13:24
Bonjour,

Bonjour/ Bonsoir je suis en stage et lors de ce stage je dois generer des fichiers PDF depuis visio en ayant accès à deux dossiers type PDF et visio
je compare les fichiers et j'exécute certaines tâches. Mon problème est le suivant je sais parcours UN dossier, UN sous dossier mais une fois que je veux accéder à un autre dossier => sous dossier ect et bien il m'envoie chier et oublie d'aller renseigner le chemin du second répertoire. en d'autre mot

ClientA => Rubrique => SRubrique OK

MAIS

ClientA => Rubrique => SRubrique IMPOSSIBLE svp aider moi je cherche comme un con des moyens de contourner le problème en vain mais impossible
=> RubriqueB 



'==============================================
'Fonction récursive de parcours d'un répertoire
'==============================================

Sub ParcoursRepT()
Call stRecInit
Call ParcoursRepB(stRepIA, stRepIB)

End Sub

Sub stRecInit()
Set oFSO = CreateObject("Scripting.FileSystemObject")
stRepIA = "C:\Users\XXX\Documents\pdf\"
stRepIB = "C:\Users\XXX\Documents\test\"
End Sub


Sub ParcoursRepB(ByVal stRepB As String, ByVal stRepA As String)

If oFSO.FolderExists(stRepB) And oFSO.FolderExists(stRepA) Then
    Set oFldB = oFSO.GetFolder(stRepB)
    For Each oSubFolderB In oFldB.SubFolders
        If oSubFolderB = "" Then
            MsgBox "coucou"
        End If

        B = Dir(oSubFolderB & "\")
        cpt = 0
        Set oFldA = oFSO.GetFolder(stRepA)
        For Each oSubFolderA In oFldA.SubFolders
            For Each oFileA In oSubFolderA.Files
                NomA = Left(oFileA.Name, Len(oFileA.Name) - 4)
                NomB = Left(B, Len(B) - 3)
                cpt = cpt + 1
                If NomA <> NomB Then
                Else
                    dtA = FileDateTime(oFileA)
                    dtA = Format(dtA, "DD-MM-YYYY HH")
                    'MsgBox ("" & dtA)
                    dtB = FileDateTime(oSubFolderB & "\" & B)
                    chemin_C = oSubFolderB & "\" & B
                    dtB = Format(dtB, "DD-MM-YYYY HH")
                    'MsgBox ("" & dtB)
                    If dtA <= dtB Then
                        'MsgBox "RAF"
                        B = Dir(oSubFolderB & "\")
                        For i = 1 To cpt
                            If B = "" Then
                            Else
                                B = Dir()
                            End If
                        Next
                    Else
                        Set doc = Documents.Open(oFileA)
                        'NomA = Left(oFileA, Len(oFileA) - 4) & "pdf"
                        doc.ExportAsFixedFormat visFixedFormatPDF, chemin_C, visDocExIntentPrint, visPrintAll
                        doc.Close
                        B = Dir(oSubFolderB & "\")
                        For i = 1 To cpt
                            B = Dir()
                        Next
                    End If
                End If
            Next oFileA
            If (oFileA Is Nothing) And (B <> "") Then
                MsgBox ("Fichier PDF unique, suppression en cours ! ")
                Kill (oFileB)
            Else
            End If

            ParcoursRepB oSubFolderB.Path, oSubFolderA.Path

        Next '// LE BUG CE SITUE ICI, IL NE SAUTE PAS CETTE ETAPE LORSQU IL DOIT CHOISIR UN AUTRE DOSSIER 

    Next
End If

End Sub



2 réponses

Réponse 1 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
25 févr. 2015 à 11:26
Bonjour,

Regarde ce code de Jacques Boisgontier : 

Dim ligne
Sub arborescenceRepertoire()
  racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, 1) = String(3 * (niveau - 1), " ") & dossier.Name
   ligne = ligne + 1
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub

Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

0
VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016 130
25 févr. 2015 à 13:29
j'avais trouvé un programme similaire mais dans mon cahier des charges l'utilisateur ne peut intervenir au sein du programme en fait j'exécute le macro en ligne de commande juste en lançant le fichier .
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016
25 févr. 2015 à 14:40
J'ai pas compris...
La macro que je te donne liste tous les fichiers d'un répertoire et de ses sous répertoires... A toi de l'adapter pour qu'elle fasse ce que tu désires...
0
VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016 130
26 févr. 2015 à 16:35
En fait mon programme que j'exécute s'occupe de lister les fichiers et répertoires de deux dossiers distinct et le soucis est que quand il remonte dans l'arborescence il s'arrête en cours de route

For each oSubFolderbis in oFldb.SubFolders
.....
For each oSubFolder in oFld.SubFolders
....
next
next

quand je remonte à mon dossier type PDF\ pour accéder ainsi à PDF\Clientsuivant
et bien il s'arrête au premiere for each et donc ne prend pas en compte le dossier VISIO\Clientsuivant
0
Réponse 2 / 2
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
27 févr. 2015 à 08:58
Bonjour,

Si j'ai bien compris...
Tu as deux répertoires contenant un nombre inconnu de sous répertoires. Le premier répertoire contient (dans ses sous-rép) des fichiers .pdf et le second des fichiers visio.
Tu souhaites, en fonction des noms des fichiers et de leurs dates de création, exporter certains fichiers visio en .pdf.
C'est cela?
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
27 févr. 2015 à 09:45
Si oui, pour plus de clarté, je procèderais de la sorte :
  • Une fonction principale => qui lance le bouzin et les fonctions dans l'ordre
  • Une fonction de "listage" des fichiers et stocke leurs noms et leurs dates de création dans une variable tableau (FicPdfs() pour les fichiers pdf et FicVisios pour les vsd)
  • Une fonction de comparaison des deux variables tableaux.


A partir du code ci-dessous :
  • adapte ce qui doit l'être
  • construit la Sub Compare

Option Explicit

'******************** * * * *   A ADAPTER  * * * * **************************************
Const RepertPdf As String = "C:\Travail\2015\PDFS"   'Chemin des fichiers pdf
Const RepertVisio As String = "C:\Travail\2015\VSDS" 'Chemin des fichiers visio
Const ExtPdf As String = "pdf"                              'Extension des fichiers pdf
Const ExtVisio As String = "vsd"                            'Extension des fichiers visio
'******************** * * * *   *   *   *   * * * * **************************************

Dim FicPdfs(), FicVisios()

Sub Principale()
Dim fs As Object, dossier_racine As Object

    'If RepertPdf = "" Or RepertVisio = "" Then Exit Sub
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'Liste les fichiers pdf et leurs FileDateTime
    Set dossier_racine = fs.getfolder(RepertPdf)
    Lit_dossier dossier_racine, 1, FicPdfs, ExtPdf, 1
    
    'Liste les fichiers vsd et leurs FileDateTime
    Set dossier_racine = fs.getfolder(RepertVisio)
    Lit_dossier dossier_racine, 1, FicVisios, ExtVisio, 1
  
    Compare
    
End Sub

Sub Lit_dossier(ByRef dossier As Object, ByVal niveau As Integer, NomF(), ext As String, i As Long)
Dim NomFic As String, d As Object

    For Each d In dossier.SubFolders
        NomFic = Dir(d & "\*." & ext)
        Do While NomFic <> ""
            ReDim Preserve NomF(1 To 2, 1 To i)
            NomF(1, i) = NomFic
            NomF(2, i) = Format(FileDateTime(d & "\" & NomFic), "DD-MM-YYYY HH")
            i = i + 1
            NomFic = Dir
        Loop
        Lit_dossier d, niveau + 1, NomF, ext, i
    Next
End Sub

Sub Compare()

End Sub
0
VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016 130
11 mars 2015 à 10:45
Merci pour ton aide mais pour finir j'ai compiler tout ça en C# et tout fonctionne bien à toi ;) là maintenant je suis passé à autre chose en PHP, si tu es doué j'aurais bien besoin de ton aide ^^ :) tient moi au courant ;) bien à toi
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751 > VlkPr3s Messages postés 235 Date d'inscription vendredi 30 mai 2014 Statut Membre Dernière intervention 27 juin 2016
11 mars 2015 à 13:24
Bonjour,

Non, désolé, je suis plutôt nul en php.
Mais n'hésite pas à poser ta question sur le forum Programmation/php...
A++
0

Discussions similaires

comment donner les droits sur fichier partage
ch'ti du 57 -
fil1958 -

2 réponses
Suppression de mail
Boulef -
Xileh -

1 réponse
Créer playlist
Mots croisés -
thegoaty -

10 réponses
parcourir une chaine en C
céline -
céline -

8 réponses