VBA Ouvrir fichier Excel particulier dans plusieurs dossiers

Le 01/06/2017 à 15:51

Bonjour à tous.

Cela fait maintenant un moment que je ne parviens pas à réaliser la macro que j'aimerais créer. J'en ai réalisé une mais elle ne fonctionne pas (voir plus bas). La macro que j'aimerais créer aurait la fonction suivante:

Il existe un répertoire (SharePoint mais c'est un détail) composé de plusieurs dossiers. Dans chaque dossiers se trouve plusieurs fichiers dont un fichier excel dont le nom commence par "SIMULATION_". La macro vient ouvrir dans chacun des dossier du SharePoint, ce fichier excel. Ensuite j'éxécute plusieurs instructions qui me permettent de copier/coller certaines données de ces fichiers excel pour les rassembler dans un fichier excel global où la macro se trouve.

Voici la macro que j'ai réalisé mais qui bloque avec une erreur de type 91 Variable non définie ou variable de bloc with non définie à l'instruction soulignée. Je pense que c'est parce que je lui demande d'ouvrir une variable qui est un "Object" et non un "Workbook". Le souci est que j'utilise derrière une boucle "For each" avec cette même variable, et cette boucle ne fonctionnera pas avec une variable du type "Workbook".

Voici la macro:

     Dim i As Long

    Sub Consolider_Simu()
        Dim S_Commande As Worksheet
        Dim Chemin As String
        Dim Extension As String

        Set S_Commande = ThisWorkbook.Sheets("Commande")
        Chemin = S_Commande.Cells(3, 2).Value
        Extension = S_Commande.Cells(4, 2).Value
        i = 6

        Nb = BoucleFichiers(Chemin, Extension)

    End Sub

    Function BoucleFichiers(Chemin As String, Extension As String) As Integer
        Dim Fso As Object
        Dim Dossier As Object
        Dim Fichier As Object
        Dim WB_TargetFichier As Workbook
        Dim TargetSheet As Worksheet
        Dim MainSheet As Worksheet

        Set Fso = CreateObject("Scripting.FileSystemObject")
        Set WB_TargetFichier = Workbooks.Open(Fichier)
        Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
        Set MainSheet = ThisWorkbook.Sheets("Main")
        BoucleFichiers = 0

        For Each Dossier In Fso.GetFolder(Chemin).SubFolders
            For Each Fichier In Dossier.Files

                If Fichier = "SIMULATION_" & "*" Then

                TargetSheet.Range("F6:G13").Select
                Selection.Copy
                MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
                MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
                Application.CutCopyMode = False
                i = i + 22
                BoucleFichiers = BoucleFichiers + 1

                WB_TargetFichier.Close savechanges:=False

                Else: i = i + 22
                End If

            Next Fichier
        Next Dossier
    End Function

Ma macro ne fonctionne malheureusement pas, j'ai le message d'erreur 91 Variable objet ou variable de bloc With non définie. Je pense que c'est parce que je lui demande d'ouvrir une variable qui est un "Object" et non un "Workbook". Le souci est que j'utilise derrière une boucle "For each" avec cette même variable, et cette boucle ne fonctionnera pas avec une variable du type "Workbook". Quelqu'un pourrait-il m'aider sur le sujet ?

À bientôt (j'espère ! )

SkillzZ

Le 01/06/2017 à 16:20

Bonjour,

Je ne vois pas la ligne surlignée...

En première lecture, je ne vois que If Fichier.Name = qui peut poser problème. (Il ne me semble pas qu'on puisse l'omettre...)

Cordialement.

Le 02/06/2017 à 09:44

Bonjour à tous, bonjour MFerrand !

Zut j'ai oublié de la surligner .. Voici le code avec la ligne surlignée:

Dim i As Long

Sub Consolider_Simu()
    Dim S_Commande As Worksheet
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set WB_TargetFichier = Workbooks.Open(Fichier)
    Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
    Set MainSheet = ThisWorkbook.Sheets("Main")
    BoucleFichiers = 0

    For Each Dossier In Fso.GetFolder(Chemin).SubFolders
        For Each Fichier In Dossier.Files

            If Fichier.Name = "SIMULATION_" & "*" Then

            TargetSheet.Range("F6:G13").Select
            Selection.Copy
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            i = i + 22
            BoucleFichiers = BoucleFichiers + 1

            WB_TargetFichier.Close savechanges:=False

            Else: i = i + 22
            End If

        Next Fichier
    Next Dossier
End Function

Une idée MFerrand ou quelqu'un d'autre par rapport à ça ? Merci de ta réponse ! Et j'ai rajouté le Fichier.Name

Bonne journée !

SkillzZ

Le 02/06/2017 à 10:33

Les informations à fournir en cas d'erreurs sont le numéro de l'erreur (le message en cas d'absence de numéro), la ligne sur laquelle survient l'erreur, les valeurs des variables au moment de l'erreur autant que possible, et le contexte dans lequel l'erreur survient.

Bon ! Tu es un peu avare en infos... mais dans ton cas, tu déclares Fichier en variable objet, tu ne l'initialises pas, donc sa valeur est Nothing, elle n'est rien ! Et de plus, la méthode Open attend le chemin et le nom du fichier, donc du texte (String).

On voit donc mal comment le classeur pourrait être ouvert si tu ne fournis rien...

Cordialement.

Le 02/06/2017 à 13:56

En fait je t'ai donné toutes les informations concernant l'erreur dans le post précédent que tu as normalement lu puisque tu y as répondu

Merci pour ta réponse MFerrand, je vais voir ce que je peux faire, mais comme je disais, j'ai défini Fichier comme un "object" pour l'inclure dans une boucle for each mais je sais bien qu'il devrait être de type "string" pour pouvoir utiliser Open ! C'est une partie de mon souci, qui encore une fois, a été expliqué dans mon premier post

J'arrive pas à trouver le moyen d'utiliser ce open mais aussi la boucle for each qui me semble nécessaire en fait

J'ai finalement un tout petit peu modifié mon code et il s'execute sans message d'erreur mais j'ai l'impression qu'il n'effectue rien. Du moins il ne fait pas ce que je souhaite. MFerrand pourrais-tu me donner une technique pour que je puisse contrôler les actions de mon code si cela existe ? J'ai déjà entendu parler de ces choses là mais je n'y connais rien.

Mon nouveau code est le suivant:

 Dim i As Long

Sub Consolider_Simu()
    Dim S_Commande As Worksheet
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainSheet = ThisWorkbook.Sheets("Simulations")
    BoucleFichiers = 0

    For Each Dossier In Fso.GetFolder(Chemin).SubFolders
        For Each Fichier In Dossier.Files

            If Fichier.Name = "SIMULATION_" & "*" Then
            Set WB_TargetFichier = Workbooks.Open(Fichier.Name)
            Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
            TargetSheet.Range("F6:G13").Select
            Selection.Copy
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            i = i + 22
            BoucleFichiers = BoucleFichiers + 1

            WB_TargetFichier.Close savechanges:=False

            End If

        Next Fichier
    Next Dossier
End Function
Le 02/06/2017 à 15:37

Inutile de lire les deux posts qui précèdent j'ai bien avancé. Mais je fais face à un dernier obstacle !

Lorsque je compile mon nouveau code:

Dim i As Long
 Dim j As Integer

Sub Consolider_Simu3()
    Dim S_Commande As Worksheet
    Dim Chemin As String
    Dim Extension As String

    Set S_Commande = ThisWorkbook.Sheets("Commande")
    Chemin = S_Commande.Cells(3, 2).Value
    Extension = S_Commande.Cells(4, 2).Value
    i = 6

    Nb = BoucleFichiers(Chemin, Extension)

End Sub

Function BoucleFichiers(Chemin As String, Extension As String) As Integer
    Dim Fso As Object
    Dim Dossier As Object
    Dim Fichier As Object
    Dim WB_TargetFichier As Workbook
    Dim TargetSheet As Worksheet
    Dim MainSheet As Worksheet

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainSheet = ThisWorkbook.Sheets("Simulations")
    BoucleFichiers = 0
    j = 9

    For Each Dossier In Fso.GetFolder(Chemin).SubFolders

        For Each Fichier In Dossier.Files

            If Left(Fichier.Name, 11) = "SIMULATION_" Then

            Set WB_TargetFichier = Workbooks.Open(Chemin & Dossier & "\" & Fichier.Name)
            Set TargetSheet = WB_TargetFichier.Sheets("SIMULATION")
            TargetSheet.Range("F6:G13").Select
            Selection.Copy
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteValues
            MainSheet.Range("D" & i).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            i = i + 22
            BoucleFichiers = BoucleFichiers + 1

            WB_TargetFichier.Close savechanges:=False

            End If

        Next Fichier

    Next Dossier
End Function

J'ai le message d'erreur suivant à propos de la ligne surlignée:

"Erreur d'éxécution 1004: Excel ne peut pas accéder au fichier "<< \\sharefrance...\SIMULATION_ADS.xlsx >>"

Mais l'adresse donnée est exactement celle où je veux accéder

Veuillez m'excuser, il y avait une erreur dans mon chemin.. Aussi petite soit-elle, l'accès était bloqué !

Merci beaucoup MFerrand pour ton aide, bon week-end de trois jours à toi, et aux autres membres du forum !

SkillzZ

Le 02/06/2017 à 21:42

Bonsoir,

Intermède de travaux jardin prolongés un peu ! Si je chemin et le nom sont bons, il s'agit bien d'un classeur Excel, je ne vois pas... Il s'agit d'une adresse réseau, reste donc à voir du côté des autorisations... surtout que le message te dit qu'Excel nepeut pas accéder.

Essaie aussi de dissocier l'ouverture de l'affectation à la variable : tu ouvres, puis tu affectes ensuite le classeur actif, pour voir si cela change quelque chose ou non.

Cordialement.

Rechercher des sujets similaires à "vba ouvrir fichier particulier dossiers"