Parcours de fichiers dans un dossier

**MartySalade** · 18/06/2019, 15h36

Bonjour j'ai un problème sur une macro que je bidouille depuis un certains temps.
Voici le concept général :
-on va chercher dans une arborescence générale des types de fichiers (préfixe-nomClient-DPT-...-x.pdf) et on les FileCopy dans un dossier destination
-En regardant le préfixe de ces types de docs on va créer les chemins pour pouvoir récuperer les fichiers.

Le problème c'est que je n'arrive pas à parcourir tout mes fichiers types. Lorsque je clique sur mon bouton il arrive à effectuer l'action sur le premier fichier mais pas sur les suivants.
Je me suis renseigné et j'ai utilisé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Do While NomFich <> ""
 
''''multitude de if pour trouver le bon chemin en fonction du préfixe
 
NomFich2 = Mid(NomFich, InStrRev(NomFich, "-") + 1)  'permet de récuperer que la fin du nom du fichier
 
NomFich3 = Dir(chemin & "*-" & NomFich2) 'on va chercher le fichiers existant dans l'arborescence 
 
If Len(NomFich3) > 0 Then
                    FileCopy chemin & NomFich3, Destination & NomFich3 'je copie le fichier trouvé dans mon dossier destination
            Else
                    MsgBox ("Le fichier " & NomFich2 & " n'existe pas")
            End If
 
        NomFich = Dir  'est censé me permettre de passer au fichier suivant
 
    Loop

Le NomFich = Dir est censé me faire passer au fichier d'après pour faire une boucle cependant il semblerait qu'il ne marche pas vu que je ne peux copier que le premier fichier et pas tout les autres (je précise que ces fichiers existent bien et que je n'ai pas de messages d'erreur type "fichier inexistants" ou autre)

Merci d'avance pour votre aide

**Philippe Tulliez** · 18/06/2019, 16h09

Bonjour;
Pour parcourir un répertoire, j'utilise la fonction Dir que j'ai intégrée dans une fonction nommée FileList qui me renvoie un tableau avec les fichiers trouvés
Code de la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function FileList(ByVal LookUpFullName As String) As Variant
  ' Renvoie une liste avec les fichiers présents dans le répertoire définit pas l'argument LookUpFullName
  ' Author : Philippe Tulliez http://www.magicoffice.be
  ' Arguments
  ' LookUpFullName (String) Répertoire + nom du fichier + extension
  Dim File As String, Counter As Integer, List()
  File = Dir(LookUpFullName)
  ReDim Preserve List(Counter): List(Counter) = File
   Do Until File = ""
    File = Dir
    If Len(File) Then
     Counter = Counter + 1: ReDim Preserve List(Counter)
     List(Counter) = File
    End If
   Loop
  FileList = List
End Function

Exemple d'une procédure qui invoque cette fonction
Dans cet exemple, la procédure affiche tous les fichiers suffixés xlsx se trouvant dans le sous-répertoire nommé Document du répertoire où se trouve la procédure VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub t()
  ' Déclaration
  Dim tbl()
  Dim Path As String, Fullname As String
  Dim Elem As Integer, msg As String
  ' Affectation
  Path = ThisWorkbook.Path & "\Document\"
  Fullname = Path & "*.xlsx"
  tbl = FileList(Fullname)
  '
  For Elem = 0 To UBound(tbl)
    msg = msg & vbCrLf & tbl(Elem)
  Next
  MsgBox msg
End Sub

**MartySalade** · 18/06/2019, 16h49

Bonjour Philippe

J'ai adapté votre code avec le mien et est remplacé les parties
msg = msg & vbCrLf & tbl(Elem) et MsgBox msg
par mon code. Cependant j'ai le même problème, aucune action n'est effectué sur les autres fichiers (seul le premier est copié)

Code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
 
Public Sub btnDPT_Click()
 
'Repère les 3 valeurs de la ListBox
DPT = DPT_number_clientLB.List(DPT_number_clientLB.ListIndex, 0)
nbdossier = DPT_number_clientLB.List(DPT_number_clientLB.ListIndex, 1)
client = DPT_number_clientLB.List(DPT_number_clientLB.ListIndex, 2)
 
DestinationHG = "C:\Users\alain\Desktop\DATA BASE\HG\"
Destination = "C:\Users\alain\Desktop\DATA BASE\DATA\"
DestinationNOTFOUND = "C:\Users\alain\Desktop\DATA BASE\NOT FOUND\"
 
NomFich = Dir(DestinationHG & "*.pdf")
 
Dim tbl()
  Dim Path As String, Fullname As String
  Dim Elem As Integer, msg As String
  ' Affectation
  Path = ThisWorkbook.Path & "Destination"
  Fullname = Path & "*.pdf"
  tbl = FileList(Fullname)
  '
  For Elem = 0 To UBound(tbl)
    prefixe2 = Left(NomFich, 2)
    prefixe3 = Left(NomFich, 3)
    prefixe4 = Left(NomFich, 4)
    chemin = "X:\1-DOSSIERS CLIENTS\" & DPT & "\" & client & "-" & DPT & "-" & nbdossier & "\"
 
    If prefixe2 = "DP" Then
            chemin = chemin & "A-DP-" & client & "-" & DPT & "-" & nbdossier & "-Demarches prealables\"
 
    ElseIf prefixe2 = "DV" Then
 
            If prefixe3 = "DV0" Then
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\" & "DV0-" & client & "-" & DPT & "-" & nbdossier & "-Courriers divers\"
 
            ElseIf prefixe4 = "DV1A" Then
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\" & "DV1A-" & client & "-" & DPT & "-" & nbdossier & "-Arpentage\"
 
            ElseIf prefixe4 = "DV1-" Then
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\" & "DV1-" & client & "-" & DPT & "-" & nbdossier & "-Demande de permis de construire\"
 
            ElseIf prefixe3 = "DV2" Then
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\" & "DV2-" & client & "-" & DPT & "-" & nbdossier & "-Demande de raccordement\"
 
            ElseIf prefixe4 = "DV3" Then
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\" & "DV3-" & client & "-" & DPT & "-" & nbdossier & "-Bail\"
 
            Else
                chemin = chemin & "B-DV-" & client & "-" & DPT & "-" & nbdossier & "-Developpement\"
 
            End If
 
 
    Else
 
            If prefixe4 = "CO00" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO00-" & client & "-" & DPT & "-" & nbdossier & "-Photos\"
 
            ElseIf prefixe4 = "CO0-" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO0-" & client & "-" & DPT & "-" & nbdossier & "-Courriers divers\"
 
            ElseIf prefixe3 = "CO1" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO1-" & client & "-" & DPT & "-" & nbdossier & "-Devis\"
 
            ElseIf prefixe3 = "CO2" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO2-" & client & "-" & DPT & "-" & nbdossier & "-Etat des lieux fiche technique\"
 
            ElseIf prefixe3 = "CO3" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO3-" & client & "-" & DPT & "-" & nbdossier & "-Branchement\"
 
            ElseIf prefixe3 = "CO4" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO4-" & client & "-" & DPT & "-" & nbdossier & "-Echanges relatifs aux travaux avec ENEDIS\"
 
            ElseIf prefixe3 = "CO5" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO5-" & client & "-" & DPT & "-" & nbdossier & "-Etude charpente\"
 
            ElseIf prefixe3 = "CO6" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO6-" & client & "-" & DPT & "-" & nbdossier & "-Plans\"
 
            ElseIf prefixe3 = "CO7" Then
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\" & "CO7-" & client & "-" & DPT & "-" & nbdossier & "-Devis signes\"
 
            Else
                chemin = chemin & "C-CO-" & client & "-" & DPT & "-" & nbdossier & "-Construction\"
 
            End If
    End If
 
        NomFich2 = Mid(NomFich, InStrRev(NomFich, "-") + 1)
        NomFich3 = Dir(chemin & "*-" & NomFich2)
 
            If Len(NomFich3) > 0 Then
                    FileCopy chemin & NomFich3, Destination & NomFich3
            Else
                    'fichier = prefixe3 & "-" & client & "-" & DPT & "-" & nbdossier & "-" & NomFich2
                    MsgBox ("Le fichier " & NomFich2 & " n'existe pas")
                    FileCopy DestinationHG & NomFich, DestinationNOTFOUND & NomFich
            End If
  Next

**Philippe Tulliez** · 18/06/2019, 17h15

Bonjour,
La fonction FileList a pour mission de renvoyer la liste de tous les fichiers se trouvant dans un répertoire particulier correspondant au nom passé par l'argument.LookUpFullName (Les caractères génériques sont autorisés).
Donc le traitement de copie suivant préfixe est un autre problème.
Il faudrait mieux expliquer les critères de copie.
Le problème vient certainement d'une mauvaise conception de l'algorithme
Personnellement, je n'utilise pas les ElseIf dont je trouve la lecture imbuvable. Je lui préfère le Select Case

**MartySalade** · 19/06/2019, 13h31

Je me doute qu'elle vient d'une mauvaise conception de l'algorithme.
Quelqu'un a t-il une idée pour fixer ce problème ?

Merci d'avance

**Philippe Tulliez** · 19/06/2019, 14h53

Bonjour,

Quelqu'un a t-il une idée pour fixer ce problème ?

Nous avons certainement plein d'idées mais comme demandé dans ma réponse précédente

Il faudrait mieux expliquer les critères de copie.

En français et pas en code VBA bien sûr

**MartySalade** · 20/06/2019, 08h31

Bonjour, qu'entendez vous par critère de copie ? Je n'ai pas compris désolé

**Philippe Tulliez** · 20/06/2019, 08h49

Bonjour,

qu'entendez vous par critère de copie ?

Les conditions comme par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
    If prefixe2 = "DP" Then
            chemin = chemin & "A-DP-" & client & "-" & DPT & "-" & nbdossier & "-Demarches prealables\"
 
    ElseIf prefixe2 = "DV" Then
 
            If prefixe3 = "DV0" Then

**MartySalade** · 20/06/2019, 10h21

J'ai remarqué que lorsque j'utilise la fonction Dir dans ma boucle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
NomFich3 = chemin & FinalPref & "-" & client & "-" & DPT & "-" & nbdossier & "-" & NomFich2
Fichier = Dir(NomFich3)

on ne peut boucler que sur un seul fichier en continu. C'est à dire que la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
NomFich = Dir()

va boucler sur le même fichier et non pas sur le suivant

Une idée de comment fixer ça ?

**MartySalade** · 20/06/2019, 10h24

Envoyé par Philippe Tulliez

Bonjour,

Les conditions comme par exemple

Je regarde le préfixe du fichier (ex : DV ou DP)
En fonction de ce préfixe je donne une valeur différente à "chemin", la variable du chemin d'accès jusqu'à mon dossier

**Philippe Tulliez** · 20/06/2019, 10h58

Bonjour,

J'ai remarqué que lorsque j'utilise la fonction Dir dans ma boucle :

Dans ton cas, on ne doit pas utiliser fonction Dir dans une boucle mais bien boucler sur les éléments du résultat renvoyé par la fonction FileList
Ce n'est pas étonnant dans ce cas que tu n'as qu'un seul élément copié

Voir l'exemple que j'ai donné (ligne 11 à 13) et remplacer la construction de la variable msg par la copie du fichier en fonction du préfixe
Soit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Elem = 0 To UBound(tbl)
    ' msg = msg & vbCrLf & tbl(Elem)
    ' ici code de la copie du fichier (définit par tbl(Elem) ) suivant préfixe
Next

**MartySalade** · 20/06/2019, 11h43

Merci pour vote réponse je comprends un peu mieux. Cependant j'ai besoin de modifier tbl(Elem) avant de faire le FileCopy.
tbl(Elem) = DP6-CLIENT-DPT-HG N AFF-mandat

Je stocke dans une variable "mandat" avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NomFich2 = Mid(tbl(Elem), InStrRev(tbl(Elem), "-") + 1)

Et grâce à mon chemin récupéré plus tôt je vais chercher mon fichier en faisant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dir(chemin & "*-" & NomFich2)

Mon tableau ne contient donc pas les bons éléments exact ?

**Philippe Tulliez** · 20/06/2019, 11h48

Bonjour,
En principe il n'y a aucune raison de modifier les éléments de la variable Tbl qui contient la liste des fichiers du répertoire mentionné dans l'argument de FileList par contre pour faire la copie on prend des sous-chaînes de tbl à l'aide des fonctions Mid, Left ou Right

**MartySalade** · 20/06/2019, 12h00

Le problème c'est que j'ai besoin de prendre des infos de tabl(Elem).
L'exemple était "mandat" mais il se peut que ce soit "promesse de bail" je ne peut donc pas utiliser un Right(tabl(Elem), x) puisque x varie selon énormément de valeur...

**Philippe Tulliez** · 20/06/2019, 13h09

Bonjour,

Le problème c'est que j'ai besoin de prendre des infos de tabl(Elem)
L'exemple était "mandat" mais il se peut que ce soit "promesse de bail" je ne peut donc pas utiliser un Right(tabl(Elem), x) puisque x varie selon énormément de valeur..

C'est bien la raison pour laquelle, je t'ai demandé quels sont les critères (conditions si tu préfères) qui font qu'un nom de classeur soit copier dans un fichier qui porte un autre nom

**MartySalade** · 20/06/2019, 13h53

Dans ce cas il y a le préfixe que j'ai évoqué plus haut (DV, DP) et le type de fichier (mandat, promesse de bail signee...)

Parcours de fichiers dans un dossier [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager