Discussion :

[lumpys]

Bonjour,

J'ai écrit le code suivant (extrait). Ce qui est bizarre c'est que si je retire les lignes en lien avec la création du dossier/sous-dossiers la boucle se fait bien (traitement des fichiers du dossier A traiter). Mais en laissant ces lignes la boucle ne se fait plus (Do While Len(Fichier) > 0 ... Loop).

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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Sub Insertion_variables()
 
    On Error Resume Next
 
    'Vérifier si une requête existe dans le dossier
    '----------------------------------------------
 
    'Application.DisplayAlerts = False
 
    'Définit le répertoire contenant les fichiers
    cheminTEST = "D:\TEST\"
    Chemin = "D:\TEST\A TRAITER\"
    CheminTalend = "D:\TEST\TALEND\"
 
 
    'Boucle sur tous les fichiers sql du répertoire.
    '-----------------------------------------------
    Fichier = Dir(Chemin & "*.sql")
 
    'Si existance d'une requête
    '--------------------------
 
    Do While Len(Fichier) > 0
 
        'Ecrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print "Longueur du nom de fichier : " & Len(Fichier)
        Debug.Print Chemin & Fichier
        Debug.Print Fichier
 
        'Insérer les données du fichier texte dans les cellules (Traitement du fichier texte ligne par ligne)
        '----------------------------------------------------------------------------------------------------
        'Application.ScreenUpdating = False
 
        Dim IndexFichier As Integer
        Dim MonFichier As String
        Dim ContenuLigne As String
 
        MonFichier = Chemin & Fichier
        IndexFichier = FreeFile()
        Open MonFichier For Input As #IndexFichier
 
        i = 1
 
        While Not EOF(IndexFichier) '
 
            Line Input #IndexFichier, ContenuLigne
 
            'Traitement à appliquer pour chaque ligne
            If Left(ContenuLigne, 1) = "'" Then
                Range("A" & i) = "'" & ContenuLigne
            Else
                Range("A" & i) = ContenuLigne
            End If
            i = i + 1
 
        Wend
 
        Close #IndexFichier ' ferme le fichier
        Application.ScreenUpdating = True
 
 
        'Rechercher param_ldc pour la création du dossier
        '------------------------------------------------
        Range("A1").Select
 
        Nb = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
 
        For i = 1 To Nb
            If Range("A" & i).Value Like "*param_ldc =*" Then
                DossParamLDC = Range("A" & i).Value
            End If
        Next i
 
        If DossParamLDC <> "" Then
            DossParamLDC = Replace(DossParamLDC, "define", "")
            DossParamLDC = Replace(DossParamLDC, "param_ldc =", "")
            DossParamLDC = Replace(DossParamLDC, "'", "")
            DossParamLDC = Replace(DossParamLDC, ";", "")
            DossParamLDC = Trim(DossParamLDC)
        Else
             DossParamLDC = "param_ldc_non_trouve"
        End If
 
        Debug.Print "Nom sous-dossier (param_ldc) : " & DossParamLDC
 
 
        'Enregistrement (sauvegarde dans un fichier texte)
        '-------------------------------------------------
 
        Dim Chaine As String
        Dim LeFichier As String
 
        LeFichier = CheminTalend & "Talend_" & Fichier
 
        Dim f As Integer
 
        f = FreeFile
 
        Open LeFichier For Output As #f
 
        Nb = Sheets("Menu").Cells(Rows.Count, 1).End(xlUp).Row
 
        For i = 1 To Nb
 
          Print #f, Cells(i, 1)
 
        Next
 
        Close #f
 
        'MsgBox "Les cellules ont été sauvegardées sous : " & LeFichier
 
        'Supprimer les cellules de la feuille Menu de ce fichier
        '-------------------------------------------------------
 
        Sheets("Menu").Cells.Select
        Selection.Delete Shift:=xlUp
        Sheets("Menu").Range("A1").Select
 
        'Création et insertion de la requête dans le dossier
        '---------------------------------------------------
 
        DateDuJour = Date
        LeMois = Format(DateDuJour, "MM")
        LeMoisLettre = Format(DateDuJour, "MMMM")
        LAnnee = Year(DateDuJour)
        nomDossier = LeMois & "_" & LeMoisLettre & "_" & LAnnee
 
        Dim Doss As String, sousDoss As String
 
        Doss = cheminTEST & nomDossier '<-- Dossier avec indication du mois et de l'année
 
        Debug.Print "Dossier : " & Doss
 
        If Dir(Doss, vbDirectory) = "" Then MkDir Doss
 
        sousDoss = Doss & "\" & DossParamLDC '<-- sous dossier Param_LDC
 
        Debug.Print "Sous-dossier : " & sousDoss
 
        If Dir(sousDoss, vbDirectory) = "" Then MkDir sousDoss
 
        FileCopy Chemin & Fichier, sousDoss & "\" & Fichier
 
        'Réinitialiser
        '-------------
        Fichier = Dir()
 
    Loop
 
 
    'Application.DisplayAlerts = True
 
    MsgBox "Traitement terminé !"
 
    'Application.Quit
 
End Sub

Quelqu'un saurait où est mon erreur ?

Merci d'avance si vous avez une solution.

[halaster08]

Bonjour,

Quelqu'un saurait où est mon erreur ?

Enlève le On Error Resume Next et VBA te dira où est ton erreur, et il te dira même de quelle nature est l'erreur.

[lumpys]

Il bloque à la ligne suivante :

Code :

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

Fichier = Dir()

ce qu'il ne fait pas lorsqu'il n'y a pas les lignes :

Code :

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

If Dir(Doss, vbDirectory) = "" Then MkDir Doss

et

Code :

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

If Dir(sousDoss, vbDirectory) = "" Then MkDir sousDoss

Qu'est ce qui pourrait créer une incompatibilité ?

[halaster08]

Quel est le message d'erreur ?