Extraction de données excel à partir d'un répertoire

Version imprimable

Bonjour,

Je rencontre un petit problème ...

J'aurais aimé savoir s'il était possible d'extraire des données en partant d'un Répertoire / dossier.

J'ai trouvé des petites lignes de codes qui me permettent de sélectionner un répertoire mais je ne sais absolument pas comment extraire des données de ces répertoires ...

Auriez-vous déjà eu affaire à ce genre de problème svp??

Ou tout simplement es que vous connaîtriez des lignes me permettant de faire ceci svp ??

Voici quelques exemples d'exploitation de répertoire que j'ai trouvé sur internet :

Exemple 1 pour trouver via un répertoire le nom des fichiers interne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub SelectionRepertoireEtAction() Dim Repertoire As FileDialog Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show If Repertoire.SelectedItems.Count > 0 Then Call BoucleDir(Repertoire.SelectedItems(1), "*.xls*") End If End Sub Private Sub BoucleDir(Chemin As String, Extension As String) Dim Fichier As String If Right(Chemin, 1) <> Application.PathSeparator Then Chemin = Chemin & Application.PathSeparator Fichier = Dir(Chemin & Extension) If Fichier <> vbNullString Then Do MsgBox Chemin & Fichier Fichier = Dir Loop While Fichier <> vbNullString End If End Sub
Exemple 2 qui me donne le chemin d'un répertoire :
Code:

1 2 3 4 5 6 7 8 Sub selectionRepertoire_afficherChemin() Dim Repertoire As FileDialog Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show MsgBox Repertoire.SelectedItems(1) End Sub

Bonjour,

Je te propose le code suivant que j'utilise souvent pour parcourir un dossier.
Il nécessite d'activer la référence Microsoft Scripting Runtime pour pouvoir l'exécuter.

La macro ouvre une boîte dialogue pour que tu sélectionnes le dossier que tu veux parcourir.
Puis elle "scanne" le dossier en bouclant sur tous les éléments qui s'y trouve.
Si l'élément trouvé est un fichier, alors tu peux faire le traitement que tu veux sur ce fichier.
Si l'élément trouvé est un sous-dossier, alors la macro s'appelle elle même (elle est récursive) pour "scanner" à nouveau ce sous-dossier et ainsi de suite.

N'hésite pas si tu veux des explications complémentaires.

Code:

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
Sub ParcourirDossier()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim Chemin As String
Dim DossierSélectionné As Folder
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Feuil1")
    Chemin = Range("Chemin").Value
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    'Traitement du fichier ouvert
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
End Sub

26/08/2020, 17h25
TheHugoGua

Merci bien de votre réponse.

J'avais néanmoins quelques questions ?

Comment activer le Microsoft Scripting Runtime ??

Et dans un second temps comment effectuer le traitement que je souhaite faire sur les fichiers svp ?

Merci d'avance pour votre réponse !
26/08/2020, 17h49
mat955
Re,

Pour activer une référence, aller dans le VBE (la fenêtre Visual Basic), cliquer sur Outils > Références... et sélectionner Microsoft Scripting Runtime dans la liste.

Ensuite, tout dépend de ce que tu veux faire, dans mon exemple, si les fichiers trouvés sont des fichiers Excel, alors ils sont ouverts, et ensuite il suffit d'écrire le code souhaité, puis de refermer le fichier. C'est ce qu'il y dans mon code à cet endroit :
Code:

1 2 3 4 5 6 Workbooks.Open Fichier Set Classeur = ActiveWorkbook 'Traitement du fichier ouvert Classeur.Close False
26/08/2020, 18h31
TheHugoGua

1 pièce(s) jointe(s)

Petit problème quand je lance la macro ...
26/08/2020, 18h41
mat955

Je pense que ça vient de la ligne suivante :

Code:

Chemin = Range("Chemin").Value

En effet, j'avais nommé une cellule "Chemin" et cette cellule contenait le répertoire par défaut à ouvrir dans la boîte de dialogue.
Et j'imagine que tu n'as pas de cellule nommée ainsi dans ton fichier, ou alors ce serait une belle coïncidence !

Il faut que tu remplaces par la cellule de ton choix qui contient le chemin par défaut.
Ou alors tu mets directement en dur le chemin dans le code VBA, mais c'est moins paramétrable.

Exemples :

Code:

Chemin = Range("A1").Value

Code:

Chemin = "C:\Bureau\MonDossier"
26/08/2020, 19h05
TheHugoGua

Ha énervant pour le coup ...

De base je souhaitais vraiment une macro modulable en fonction de différent fichiers ...
26/08/2020, 19h16
mat955

C'est tout à fait faisable, il suffit d'adapter le code.

Si tu coinces n'hésite pas à exprimer le plus clairement possible ton besoin, et on voit ce qu'on peut faire.

EDIT : Le chemin que tu vas renseigner sert juste pour la boîte de dialogue qui va s'ouvrir.
Su tu mets le chemin du bureau par exemple, la boîte de dialogue va s'ouvrir par défaut sur le bureau, mais à partir de là, rien de t'empêche de te promener dans l'arborescence pour aller chercher le dossier que tu veux "scanner".
26/08/2020, 20h03
TheHugoGua

Yes c'est exactement ça je voudrais me promener dans l'arborescence pour aller sélectionner le dossier à traiter !

J'essaye de regarder ça de prêt et je vous redis !

Merci dans tous les cas pour vos précieux conseils !!

Hello j'ai essayé de bidouiller un peu mais vraiment sans succès ...

Voici ce que j'ai réalisé :

Code:

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
Sub ParcourirDossier()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim Chemin As String
Dim DossierSélectionné As Folder
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Feuil1")
    Chemin = "C:\Users\HUGO\Desktop\Macro\Fichier Exemple"
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    Basededonnées.Sheets(2).Range("A1").Copy
 
                    ThisWorkbook.Sheets(2).Range("A1").PasteSpecial xlPasteValues
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
End Sub

Est-ce dans l'esprit ?
Sauriez-vous pourquoi ça ne fonctionne pas ??

Merci d'avance pour votre réponse

27/08/2020, 16h38
mat955
Bonjour,

Il faudrait que tu nous dises ce qui ne fonctionne pas.
As-tu un message d'erreur ? Si oui, quel est-il et à quel niveau du code ?

D'emblée, je pense qu'il y a une erreur avec la ligne suivante :

Code:

Basededonnées.Sheets(2).Range("A1").Copy

Je n'ai pas vu de déclaration de variable de ce nom là, donc ça doit buguer.
Si tu voulais faire référence au fichier ouvert, mon code affecte à la variable Classeur le classeur justement ouvert :
Code:

1 2 Workbooks.Open Fichier Set Classeur = ActiveWorkbook
Tu dois donc remplacer ton code par :

Code:

Classeur.Sheets(2).Range("A1").Copy

Bonjour,

Au final j'ai bien réussi à faire fonctionner votre macro mais pas comme je le souhaitais !

La macro comme je l'ai utilisé Copie Colle les mêmes la case de tous les fichiers sur la même case de finale.

Sauriez-vous vous comment sélectionner une certaine plage de valeur en fonction de chaque fichier svp ?

Merci d'avance pour votre réponse et merci beaucoup pour les conseils que vous me prodiguez.

Cordialement, Hugo.

Code:

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
Sub ParcourirDossier()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim Chemin As String
Dim DossierSélectionné As Folder
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Feuil1")
    Chemin = "C:\Users\HUGO\Desktop\Macro\Fichier Exemple"
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    Classeur.Sheets(2).Range("A1").Copy
 
                    ThisWorkbook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
 
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
End Sub

28/08/2020, 10h42
mat955

Citation:

Envoyé par TheHugoGua

Sauriez-vous vous comment sélectionner une certaine plage de valeur en fonction de chaque fichier svp ?

Oui, mais il faut que tu sois plus précis dans ce que tu souhaites faires exactement.
Est-ce une plage fixe ? Est-ce une plage variable en fonction de certains paramètres ? etc...
Il nous faut tous les paramètres à prendre en compte pour que la macro sache quoi aller chercher comme plage.

Pareil pour la copie dans le fichier dans lequel tu colles les données, il est tout à fait possible de coller les données à chaque fois en dessous des précédentes pour faire une sorte de compilation.

Je te laisse préciser ta demande pour pouvoir ensuite t'aiguiller si besoin.
28/08/2020, 11h38
TheHugoGua

En gros ce que je souhaite effectuer de base c'est une macro qui me fait une synthèse de différents fichiers excel.

Par exemple mes fichiers excel sont des semaines et lorsque je lance ma macro elle va venir interroger le répertoire où mes fichiers / semaine sont contenus pour en faire une synthèse du mois.

Il est important de savoir que mes fichiers excel ne portent pas le même nom et sont variables ( Ne contiennent pas les mêmes valeurs ni le même nombre de lignes ).

Pour l'instant grâce à votre aide j'ai réussi à faire questionner + extraire des données d'un répertoire.

Actuellement les points qui restent flous sont les suivants : - Je ne sais pas vraiment comment définir une plage de valeurs variable à copier + coller dans mon fichier de synthèse

- De plus j'ai la même contrainte pour tous les autres fichiers mais je dois rajouter un décalage entre les extractions des différents fichiers pour éviter qu'il ne se copie colle les uns sur les autres ...
28/08/2020, 11h51
mat955

Citation:

Envoyé par TheHugoGua

Je ne sais pas vraiment comment définir une plage de valeurs variable à copier + coller dans mon fichier de synthèse

Pour sélectionner les données de ta feuille 2, peu importe le nombre de lignes, utilises la propriété CurrentRegion, qui va sélectionner toutes les cellules actives de la feuille, donc celles qui ont des valeurs

Code:

Classeur.Sheets(2).Range("A1").CurrentRegion.Copy

Citation:

- De plus j'ai la même contrainte pour tous les autres fichiers mais je dois rajouter un décalage entre les extractions des différents fichiers pour éviter qu'il ne se copie colle les uns sur les autres ...

Il suffit de se placer à la fin des données déjà existante grâce aux propriétés End et Offset.

End permet d'atteindre la dernière cellule contenant une valeur, dans une direction spécifiée (en l'occurence vers le bas)
Offset te permet de se décaler d'un certains nombre de lignes ou colonnes à partir d'une cellule (en l'occurence on se décale d'une ligne vers le bas pour se placer directement sous la dernière cellule contenant une valeur)

Code:

ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues

2 pièce(s) jointe(s)

Parfait c'est exactement ce qu'il me fallais.

En revanche je rencontre encore un petit souci ...

Pour l'instant je faisais tourner la macro sur un fichier de test qui contenait qu'une feuille.

Par la suite je souhaiterais que mon fichier final ait en feuille 1 un bouton qui fait tournée ma macro puis ensuite une feuille ou vient ce coller le résultat de ma macro.

J'ai essayé de modifier le code mais la macro n'a pas apprécié ...

Et dans un second temps je me demandais s'il était possible de sélectionner des régions plus sélectives (Colonne où directement cellule) car le currentregion est un peu trop sélectif pour mon cas d’utilisation ...

Merci d'avance pour votre réponse.

Hugo
Voici mon code modifié :
Je crois qu'il m'affichais le code erreur 1004 MVB
Pièce jointe 578093 Pièce jointe 578094

Code:

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
Sub synthèse()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim DossierSélectionné As Folder
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Synthèse")
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    Classeur.Sheets(2).Range("A1").CurrentRegion.Copy
 
                    ThisWorkbook.Sheets(2).Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
 
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
 
End Sub

31/08/2020, 09h52
TheHugoGua

Bonjour, j'espère que vous avez passé un bon week-end !

J'aurais voulu savoir si vous aviez bien vu mon dernier message ?

Bonne journée à vous !

Cordialement,

Hugo.