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
| 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("Calcul2").Columns("C").Find(strFile, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
' Ouvrir le fichier
Workbooks.Open ThisWorkbook.Path & "\" & strFile
Chemin = ThisWorkbook.Path & "\" & strFile
Set Objet = CreateObject("Scripting.FileSystemObject")
Set Fichier = Objet.GetFile(Chemin)
' Copie des données
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
' 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 |
Partager