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