Discussion :

[flosauveur69]

Bonjour,


J`ai la macro suivante avec lesquels je veux récupérer les données de fichiers html qui sont dans le même répertoire que mon classeur Excel. Jusque-là cela fonctionne par contre je n`arrive pas à récupérer les données qui sont dans les sous répertoire car il y des fichier html aussi dans les sous répertoire. Autre problème, les sous répertoire ne sont pas figés et il peut y en avoir des nouveaux.

Je vous mets mon arborescence en PJ.

Merci d`avance pour votre aide

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
Public Sub cmdRecupere_Click()
Dim strWB As String, strFile As String
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
' Nom du classeur actuel
strWB = ThisWorkbook.Name
 
' Récupération du premier fichier dans le répertoire et sous repertoire
strFile = Dir(ThisWorkbook.Path & "\*.html")
 
' Boucle du 1er au dernier classeur dans le répertoire et sous repertoire
Do While strFile <> ""
' Si le classeur n'est pas "Total.xls" et si son nom n'existe pas en colonne C
If strFile <> strWB And Worksheets("AV_AP_DVR1").Columns("C").Find(strFile , LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile
 
' Copie des données
Workbooks(strFile).Worksheets(1).Range("A13:C28"). Copy
With Workbooks(strWB).Worksheets("AV_AP_DVR1")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("c2:c17").ClearContents 'on ne garde que les données A2:B17
.Range("C2") = strFile
End With
 
' Fermeture du classeur
Workbooks(strFile).Close
End If
 
' Classeur suivant
strFile = Dir
Loop
 
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
End Sub

[kiki29]

Salut, t'inspirer de http://www.developpez.net/forums/d20...feuille-excel/ pour une recherche récursive dans les sous dossiers

[flosauveur69]

Salut,

j`étais déjà tombe ce lien, le problème c`est que je suis pas un crack du VBA du coup je ne vois pas trop comment adapter ces lignes de code et les inclure dans mon fichier,

merci d`avance pour l`aide

[flosauveur69]

J`ai trouve solution a mon probleme, pour rappel:

ma Macro doit ouvrir chaque fichier de 2 répertoires, et copier une plage de cellules. Le classeur est ouvert si il n`a jamais été ouvert et si son datelastmodified est compris entre 2 dates.

Le dernier problèmeque je rencontre c`est que quand je compile, j`ai un message d`erreur Object Required
Second problème, la macro ouvre chaque fichier en bas de l`écran avant de copier les données ce qu`elle ne devra pas faire grâce au Application.ScreenUpdating = False


Merci de votre aide

ma macro:

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
Public Sub cmdRecupere_Click()
 
Dim strWB As String, strFile As String
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
 
' Name of this workbook
strWB = ThisWorkbook.Name
 
' Recuperation of the 1st workbook of the directory
strFile = Dir("D:\testlist\CMV42" & "\*.html")
 
' Loop between the 1st and last workbook
Do While strFile <> ""
 
chemin = "D:\testlist\CMV42" & "\" & strFile
Set Objet = CreateObject("Scripting.FileSystemObject")
Set Fichier = Objet.GetFile(chemin)
 
' If the name of the workbook doesnt exists in column C
If Fichier.DateLastModified >= UserGuide!I1 And Fichier.DateLastModified <= UserGuide!J1 Then
ElseIf strFile <> strWB And Worksheets("Calcul2").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
 
 
' Open Workbook
Workbooks.Open "D:\testlist\CMV42" & "\" & strFile
 
' Datas copy
Workbooks(strFile).Worksheets(1).Range("A11:C28").Copy
With Workbooks(strWB).Worksheets("Calcul2")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("c2:c19").ClearContents 'on ne garde que les données A2:B17
.Range("C3") = strFile
.Range("C2") = Fichier.DateLastModified
 
End With
 
' Close Workbook
Workbooks(strFile).Close
End If
 
' Next Workbook
strFile = Dir
Loop
 
 
' Next Directory
 
' Recuperation of the 1st workbook of the directory
strFile = Dir("D:\testlist\CMV01" & "\*.html")
 
' Loop between the 1st and last workbook
Do While strFile <> ""
 
chemin = "D:\testlist\CMV01" & "\" & strFile
Set Objet = CreateObject("Scripting.FileSystemObject")
Set Fichier = Objet.GetFile(chemin)
 
' If the name of the workbook doesnt exists in column C
If Fichier.DateLastModified >= UserGuide!I1 And Fichier.DateLastModified <= UserGuide!J1 Then
ElseIf strFile <> strWB And Worksheets("Calcul2").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
 
 
' Open Workbook
Workbooks.Open "D:\testlist\CMV01" & "\" & strFile
 
' Datas copy
Workbooks(strFile).Worksheets(1).Range("A11:C28").Copy
With Workbooks(strWB).Worksheets("Calcul2")
.Range("A2").Insert xlDown 'insertion en ligne 2
.Range("c2:c19").ClearContents 'on ne garde que les données A2:B17
.Range("C3") = strFile
.Range("C2") = Fichier.DateLastModified
 
 
End With
 
' Close Workbook
Workbooks(strFile).Close
End If
 
' Next Workbook
strFile = Dir
Loop
 
 
Application.EnableEvents = True
Application.ScreenUpdating = True
 
MsgBox "Le traitement des fichiers est terminé.", vbInformation, "Traitement..."
 
End Sub