Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

[mattic59]

Bonjour,

J'ai récupéré et adapté un code que j'ai adapté pour récupérer les données d'un fichier excel en les copiant dans un autre de compil (cf. ci-dessous). En revanche je n'arrive pas à mettre en place une boucle qui me permettrait de :
- ouvrir tous les documents d'un répertoire (structurés exactement de la même façon)
- coller les données du 1er magasin sur la 3ème colonne , du second dans la 4ème, ...

Pourriez-vous m'aider et d'avance merci pour votre aide !!!

Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Cellule As String, Feuille As String

'Adresse de la cellule contenant la donnée à récupérer
Cellule = "H8:H50"
Cellule2 = "C3:c4"

Feuille = "SYNTHESE$"
'Chemin complet du classeur fermé ==> que je souhaite remplacer par tous les fichiers d'un même répertoire
Fichier = "D:\XX\YY.xls"


Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"

Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule2 & "]"
End With

Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

Set Rst = Source.Execute("[" & Feuille & Cellule2 & "]")

Range("A1").CopyFromRecordset Rst
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"

Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With

Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic

Set Rst = Source.Execute("[" & Feuille & Cellule & "]")

Range("A3").CopyFromRecordset Rst
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Sub

 

[flyonets44]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Bonjour
en t'inspirant de ce code publié sur ce site le 17/08;
faire une recherche sur ouvrir les fichiers d'un dossier
Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object, wb As Workbook

Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\TEST EXCEL\"

For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
For Each f2 In f1.Files
Set wb = Workbooks.Open(f2)
'tes instructions
wb.Close
Next f2
Next f1
End Sub

 

[mattic59]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Bonjour,

Peux-tu me préciser le message auquel tu fais allusion car il y a plus de 5 pages de post qui font référence à cela ? (sachant que je souhaiterai que l'import des données se fasse sans ouvrir les fichiers excels)

Merci d'avance

 

[flyonets44]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Bonjour
dans ce forum tu fais une recherchesur ouvrit fichier
tout simplement
Cordialement
Flyonets

 

[mattic59]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Désolé d'être insistant mais pourrais-tu me préciser (pour faciliter mes recherches) la personne à l'initiative du post car j'ai déjà parcouru le forum en large et en travers et je n'avais pas encore trouvé de sujet qui traîte de ce problème (sinon je n'aurai pas ouvert de discussion).
J'ai bien trouvé des sujets qui traitent d'une recopie de données d'une feuille vers une autre feuille sans avoir à ouvrir le fichier, des sujets qui traitent de la récupération de plusieurs feuilles en copiant les données vers un fichier mais en ouvrant systématiquement les fichiers; mais je n'ai pas trouvé de code qui me fasse les 2 (j'ai bien essayé de mon côté mais mon code coince) à savoir récupérer les données de tous les fichiers d'un répertoire pour les compiler dans un seul fichier sans les ouvrir.

Merci d'avance pour ton aide

 

[flyonets44]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

bonjour
je ne dispose pas de code pour répondre à ta question d'importation sans ouverture de fichier
à mon sens, l'ouverture et import de fichier est + rapide que la lecture avec ado
Cordialement
flyonets

 

[Jam]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Salut Mattic, Flyonets44,

Comme l'indique Flyonets dans son dernier post, la méthodologie proposée est particulièrement rapide et moins compliquée (à mon sens) à mettre en place que des requêtes ADO.

Tu trouveras ci-après un code que j'utilise permettant d'ouvrir une multitude de fichiers identique et de recopier dans un onglet les différentes données récupérées de ces fichiers. La procédure est identique à celle de Flyonets.
Tu pourras noter dans ce code que j'attribue des variables aux classeurs/onglets ceci pour 3 raisons importantes: lisibilité du code, gestion des liens entre fichier source et fichier destination (cela évite les confusions), optimisation de la vitesse du code (ce point étant souvent mis de côté). Concernant l'utilisation de variables je ne peux que te conseiller de le faire même si tu souhaites continuer à écrire ton code via ADO.

Petites précisions sur la structure du code: Le module SelectFolder est lié à un bouton dans une feuille qui permet de sélectionner le classeur avant de lancer la seconde procédure, le chemin étant stocker dans une cellule nommée ("sPath" ici).
Enfin, cette procédure comporte une boucle qui devrait t'aider dans ton cas: recopie des données dans un onglet unique tout en incrémentant d'une ligne à chaque fichier ouvert.

Voilà, j'espère que cela pourra t'aider.

Option Explicit

'==========================================
'= Procédure de sélection d'un répertoire =
'= Utilise le scripting object            =
'==========================================
Sub SelectFolder()
    Dim fd As FileDialog
    Dim vrtSelectedItem As Variant
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                Range("sPath") = vrtSelectedItem
            Next vrtSelectedItem
        End If
    End With
    Set fd = Nothing
    
End Sub

'========================
'= Procédure principale =
'========================
Sub Main()
    '# Déclaration des variables de la procédure
    Dim oFso        As Object
    Dim oFile       As Object
    Dim oDirectory  As Object
    Dim wkbMain     As Workbook
    Dim wkbPAT      As Workbook
    Dim wks         As Worksheet
    Dim i           As Long   'Compteur pour décalage des lignes
    
    '# Création des objets de scripting
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set oDirectory = oFso.getfolder(Range("sPath"))
    
    '# Affectation de la variable wkbMain au classeur accueillant les données
    Set wkbMain = ThisWorkbook
    
    '# On active la gestion d'erreur
    On Error GoTo GestionErreur
    
    '# On vérifie qu'il y a bien des fichiers dans le répertoire
    If Not (oDirectory.Files.Count > 0) Then
        MsgBox "Le répertoire sélectionné ne contient aucun fichier !", vbCritical + vbOKOnly, "Erreur répertoire"
        Exit Sub
    End If
    
    '# Effacement de la plage de données
    wksDatabase.Range("A1").CurrentRegion.Clear
    
    '# Désactivation de certains paramètres pour accélerer le traitement
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    '# On parcours tous les fichiers du répertoire
    For Each oFile In oDirectory.Files
        '# Si le fichier est un fichier Excel on l'ouvre.
        If Right(oFile.Name, 4) = ".xls" Then
            Workbooks.Open Range("sPath") & "\" & oFile.Name, 0 '<- 0: ne pas mettre à jour les liens externes.
            Set wkbPAT = ActiveWorkbook
            '# On parcours les onglets du fichier.
            '# S'il s'agit d'un nombre c'est un site et on copie.
            For Each wks In wkbPAT.Worksheets
                
                '# Si le nom fait 3 caractère alors il s'agit d'un site
                If Len(wks.Name) = 3 Then
                    
                    i = i + 1
                    '# On copie les infos récupérées dans la feuile BDD
                    With wksDatabase
                        .Cells(i, 1) = Format$(wks.Name, "000")
                        .Cells(i, 2) = wks.Range("D13")
                        .Cells(i, 3) = wks.Range("E13")
                        .Cells(i, 4) = wks.Range("D22")
                        .Cells(i, 5) = wks.Range("E22")
                        .Cells(i, 6) = wks.Range("G24")
                    End With
                    
                End If
                
            Next
            
        End If
        
        '# On ferme le fichier après récupération
        wkbPAT.Close SaveChanges:=False
    Next
    
GestionErreur:
    '# On ferme les objets créés
    Set oFso = Nothing
    Set oDirectory = Nothing
    Set wkbPAT = Nothing
    Set wkbMain = Nothing
    
    '# Rétablissement des paramètres Excel
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .StatusBar = False
    End With
    
    MsgBox "Les données des fichiers ont été importées avec succès.", vbOKOnly + vbInformation, "Fin Traitement PAT"

End Sub

[COLOR=#323232][FONT=Arial][/FONT][/COLOR]

 

[flyonets44]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Bonjour Jam, mattic59
c'est clair, net et sans bavure
Bravo l'artiste
Cordialement
Flyonets

 

[JiJi78]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Bonjour,


J'ai un document Excel comportant le même code VBA que celui proposé par Jam. Je souhaiterais le réutiliser pour effectuer un travail identique. Je dois exécuter cette macro dans un nouveau classeur Excel et avec des fichiers source présents dans un répertoire que je définis.

Lorsque j'exécute cette macro, j'obtiens le message d'erreur suivant:



Je clique donc sur "débogage" et la fenêtre suivante s'ouvre:



Je ne sais pas quelle est mon erreur et c'est en cela que je me tourne vers vous.

En effet, le code VBA est sensiblement le même que celui que j'ai récupéré dans un document de travail. J'imagine qu'il faut que je l'adapte tel que je le souhaite mais je bloque à l'étape de sélection du répertoire source.


Merci de votre aide et de vos renseignements,

JiJi78

 

[Jam]

Re : Récupérer les données de plusieurs fichiers d'un même répertoire sans les ouvrir

Salut Jiji78

Il suffit juste de nommer une cellule "sPath", et de mettre dedans le chemin que tu vas utiliser.

Bon courage