Verifier si classeur present dans un dossier

Bonjour à tous,

J'aurais besoin d'une macro qui vérifie en permanence si il y a un classeur dans le dossier C:\Users\Admin\Desktop\Test\ et l'ouvre dès qu'un classeur est trouvé.

Merci d'avance

David

Bonjour,

Teste ceci :

Sub OuvrirSiPresent()

    Dim Chemin As String
    Dim Classeur As String

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'adapter le nom...
    Classeur = "Classeur1.xls"

    If Dir(Chemin & Classeur) <> "" Then

        Workbooks.Open Chemin & Classeur

    Else

        Chrono

    End If

End Sub

Sub Chrono()

    'toutes les 5 minutes...
    Application.OnTime Now + TimeValue("00:05:00"), "OuvrirSiPresent"

End Sub

il te faut adapter le nom du classeur et exécuter la sub "OuvrirSiPresent" si le classeur ne s'y trouve pas encore, un chrono est déclanché et le contrôle se fera toutes les 5 minutes

Merci pour ta réponse rapide

Désolé, mais je n'ai pas pensé à précisé que ça n'est pas pour un classeur en particulier mais pour tous les classeurs qui sont présent dans le dossier, donc je ne connais pas sont nom, du moins pas en entier, il commencera par Com... , ça sera des fichier du genre Com154533, Com196354 ,Com983231 ...

Donc, teste ça :

Sub OuvrirSiPresent()

    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Chemin As String
    Dim Nom As String
    Dim I As Integer

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'récupère tous les classeurs contenus dans le dossier
    Tbl = EnumFichiers(Chemin, ".xls")

    'concatène tous les noms des classeurs déjà ouverts pour faciliter la recherche
    For Each Cls In Workbooks: Nom = Nom & Cls.Name: Next Cls

    'recherche le ou les noms des classeurs dans ceux déjà ouverts
    'si pas trouvé, l'ouvre
    For I = 1 To UBound(Tbl)

        If InStr(Nom, Tbl(I)) = 0 Then Workbooks.Open Chemin & Tbl(I)

    Next I

    'relance la recherche dans 5 minutes
    Chrono

End Sub

Sub Chrono()

    'toutes les 5 minutes...
   Application.OnTime Now + TimeValue("00:05:00"), "OuvrirSiPresent"

End Sub

Function EnumFichiers(Chemin As String, Extension As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    'récupère seulement les fichiers Excel xls, xlsm, xlsx, etc...
    Fichier = Dir(Chemin & "*" & Extension & "*")

    'boucle sur les fichiers du dossier
    Do While (Len(Fichier) > 0)

        I = I + 1

        ReDim Preserve TableauFichiers(1 To I)

        TableauFichiers(I) = Fichier

        Fichier = Dir()

    Loop

    'retourne le tableau des noms de fichiers
    EnumFichiers = TableauFichiers()

End Function

Quand je lance la macro ca fonctionne, mais j'ai une erreur quand elle est relancer par le chrono, ca doit pas etre grand chose mais je vois pas d'où ca vient:

Impossible d'executer la macro "C:\Users\Admin\Desktop\Classeur.xlsm'!OuvrirSiPresent'. Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées

Je remarque aussi que ca ouvre tous les classeurs present dans le dossier, comment puis-je faire pour arrêter la macro juste après l'ouverture du premier classeur et la relancer à sa fermeture

Désolé, ça m’embête de pas tous demander tous en même temps mais je me rend compte seulement maintenant

Je viens de faire des tests avec une relance toutes les 10 secondes et ça fonctionne très bien même en étant entrain de faire des modif dans un des classeurs ouvert.

Attention, le classeur qui contient la macro doit rester ouvert, c'est le cas ?

Autant pour moi, je l'avais placé dans feuil1 et pas dans un module

Super ça fonctionne très bien

Reste s'il est possible d’arreter la macro dès qu'elle ouvre le premier classeur et la relance quand il est fermé

Bonjour,

Une fois le chrono arrêté, il faut un évènement pour le relancer !

Pour l'arrêter, pas de problème avec une variable de contrôle mais pour le relancer il faudrait intercepter la fermeture du classeur sur l'évènement "Workbook_BeforeClose" si ce classeur est à demeure dans le dossier, il suffit de coller ce code dans le module du classeur :

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Application.Run "Classeur1.xls!'Chrono'"

End Sub

Où il faut adapter le nom du classeur (ici "Classeur1.xls") il va sans dire que ce dernier doit être ouvert !

Bonjour Theze,

Je préfere que tous soit dans le premier classeur, apparemment ça fonctionne, peut tu me dire si c'est correct d’insérer mon code entre For Next comme ceci:

Sub OuvrirSiPresent()

    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Chemin As String
    Dim Nom As String
    Dim I As Integer

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'récupère tous les classeurs contenus dans le dossier
   Tbl = EnumFichiers(Chemin, ".xls")

    'concatène tous les noms des classeurs déjà ouverts pour faciliter la recherche
   For Each Cls In Workbooks: Nom = Nom & Cls.Name: Next Cls

    'recherche le ou les noms des classeurs dans ceux déjà ouverts
   'si pas trouvé, l'ouvre
   For I = 1 To UBound(Tbl)

        If InStr(Nom, Tbl(I)) = 0 Then Workbooks.Open Chemin & Tbl(I)

        ICI MON CODE POUR TRAITER LE CLASSEUR QUI VIENS DE S'OUVRIR 

        ActiveWorkbook.Close    FERMETURE DU CLASSEUR 

    Next I     REVERIFICATION SI AUTRES CLASSEUR EST PRESENT DANS LE DOSSIER

   Chrono    SINON CHRONO

End Sub

Edit: Apparemment j'ai des soucis en plaçant mon code dans la boucle, j'ai essayé de trouver comment la supprimer mais je n'y arrive pas, si tu peux l'enlever ça sera parfait, de toute façon elle ne me sert pas vu que je préfère ouvrir un classeur à la fois

Bonjour,

Es ce que quelqu'un pourrais juste supprimer la boucle dans ce code, je n'arrive pas à le faire correctement

Il me manque juste ça et ça serait parfait mais la je suis vraiment bloqué

Merci

Sub OuvrirSiPresent()

    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Chemin As String
    Dim Nom As String
    Dim I As Integer

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'récupère tous les classeurs contenus dans le dossier
   Tbl = EnumFichiers(Chemin, ".xls")

    'concatène tous les noms des classeurs déjà ouverts pour faciliter la recherche
   For Each Cls In Workbooks: Nom = Nom & Cls.Name: Next Cls

    'recherche le ou les noms des classeurs dans ceux déjà ouverts
   'si pas trouvé, l'ouvre
   For I = 1 To UBound(Tbl)

        If InStr(Nom, Tbl(I)) = 0 Then Workbooks.Open Chemin & Tbl(I)

    Next I

    'relance la recherche dans 5 minutes
   Chrono

End Sub

Sub Chrono()

    'toutes les 5 minutes...
  Application.OnTime Now + TimeValue("00:05:00"), "OuvrirSiPresent"

End Sub

Bonjour,

Comme je ne vois pas trop ce que tu veux faire, voici un code où seul le premier classeur trouvé est ouvert à condition qu'il ne soit pas déjà ouvert :

Sub OuvrirSiPresent()

    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Chemin As String
    Dim Nom As String

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'récupère tous les classeurs contenus dans le dossier
    Tbl = EnumFichiers(Chemin, ".xls")

    'concatène tous les noms des classeurs déjà ouverts pour faciliter la recherche
    For Each Cls In Workbooks: Nom = Nom & Cls.Name: Next Cls

    'n'ouvre que le premier classeur à condition qu'il ne soit pas déjà ouvert
    If InStr(Nom, Tbl(1)) = 0 Then Workbooks.Open Chemin & Tbl(1)

    'relance la recherche dans 5 minutes
    Chrono

End Sub

Parfait, c'est ce qu'il me fallait

Merci beaucoup Theze

GRrrr, j'ai parler trop vite

Le code plante quand il n'y a plus de classeur à ouvrir, que puis-je faire?

Bonjour,

Teste ce code, ça ne devrait plus planter :

Sub OuvrirSiPresent()

    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Chemin As String
    Dim Nom As String

    Chemin = "C:\Users\Admin\Desktop\Test\"

    'récupère tous les classeurs contenus dans le dossier
    Tbl = EnumFichiers(Chemin, ".xls")

    If Not (Not Tbl) Then

         'concatène tous les noms des classeurs déjà ouverts pour faciliter la recherche
        For Each Cls In Workbooks: Nom = Nom & Cls.Name: Next Cls

         'n'ouvre que le premier classeur à condition qu'il ne soit pas déjà ouvert
        If InStr(Nom, Tbl(1)) = 0 Then Workbooks.Open Chemin & Tbl(1)

    End If

    'relance la recherche dans 5 minutes
    Chrono

End Sub

Bonjour,

Entre temps j'ai trouvé une solution que j'ai ajouter à ton code pour ne pas planter quand le dossier est vide, mais je vais quand même prendre ton nouveau code car il est nettement plus optimisé

Par contre j'ai un autre soucis, je dois être maudis

Quand un fichier arrive dans le dossier, par exemple 17643.xlsx, pendant qu'il se sauvegarde il est accompagné de ~$17643.xlsx, et il arrive parfois que la macro essai d'ouvrir ce fichier

Pourrait on exclure de la macro l'ouverture des fichiers commençant par ~

Regarde avec ceci :

Function EnumFichiers(Chemin As String, Extension As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    'complète le chemin le cas échéant
   If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    'récupère seulement les fichiers Excel xls, xlsm, xlsx, etc...
   Fichier = Dir(Chemin & "*" & Extension & "*")

    'boucle sur les fichiers du dossier
   Do While (Len(Fichier) > 0)

        If Left(Fichier, 2) <> "~$" Then

           I = I + 1

           ReDim Preserve TableauFichiers(1 To I)

           TableauFichiers(I) = Fichier

           End If

        Fichier = Dir()

    Loop

    'retourne le tableau des noms de fichiers
   EnumFichiers = TableauFichiers()

End Function

Perfetto !

Merci Beaucoup pour ton aide

Rechercher des sujets similaires à "verifier classeur present dossier"