XL 2016 Macros Excel, attendre la fermeture d'un répertoire avant de continuer le code

didus · 2 Avril 2022

Bonjour,
je travaille bénévolement pour une association et je maintiens un tableau Excel partagé sous dropbox que je fais évoluer au fil du temps.
Mon dernier problème, après avoir mis en place des extractions automatisées dans un répertoire pour des besoins ponctuels,
que ce répertoire soit systématiquement vide, les extractions ayant un nom fixe, elles risquent de causer des bugs dans le code et je préfère que ce soit les utilisateurs
qui suppriment ou déplacent ces fichiers plutôt qu'un RAZ systématique au démarrage.

donc à l'ouverture du classeur le répertoire est testé, s'il n'est pas vide un message apparait et le répertoire est ouvert, comme je souhaite être sur de l’absence de fichier
je teste en boucle, mais le code continue à tourner une fois le répertoire ouvert pour purge, je voudrais qu'il attende sa fermeture...

J'ai essayé do while, for next, mais je n'ai rien trouvé sur le net ou dans le forum pour y parvenir...
ça doit pas être trop compliqué mais tout seul sans aide je suis comme un oisillon tombé du nid...
merci d'avance

je peux copier le code, pour mes feuilles, elles contiennent 1600 noms c'est plus délicat

Bernard_XLD · 2 Avril 2022

Bonjour didus, le forum

Regardez du coté de Application.Ontime avec un appel en boucle tant que le test n'est pas bon ou qu'une durée est achevée.

Cordialement, @+

didus · 2 Avril 2022

merci je vais voir de ce pas

didus · 2 Avril 2022

bien trouvé, la procédure et des exemples, voir des tableaux mais je n'ai pas vraiment de procédure à exécuter, ce test est réalisé à l'ouverture de mon classeur, voici mon code global
mis en observation ma tentative avec le timer, la question porte sur la partie 2, "second test"

VB:

Option Explicit

Private Sub Workbook_Open()
Sheets("Liste personnes").Select
Call nettoyage

'Macro créant un fichier texte à l'ouverture du classeur partagé (Dropbox) pour indiquer à d'autres utilisateur que celui-ci est ouvert.
'La première partie vérifie si le fichier texte n'existe pas déjà au cas où l'utilisateur n'aurait pas fait attention.

'Définition des variables
Dim Emplacement, Nom As String
Emplacement = ThisWorkbook.Path & "\" 'Emplacement de ce classeur
Nom = "Le fichier des anciens est deja ouvert.txt" 'Nom du fichier texte créé

    'Vérification
If Emplacement & Nom <> "" And Len(Dir(Emplacement & Nom)) > 0 Then
   MsgBox "Attention, ce classeur semble être ouvert par un autre utilisateur." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & _
   "Continuer de travailler et enregistrer ce fichier créera certainement un fichier en conflit.", vbExclamation, "Attention"
   Exit Sub
End If

    'Création du fichier texte
Open Emplacement & Nom For Output As #1
Print #1, "Le fichier " & ThisWorkbook.Name & " est ouvert par un utilisateur !" 'On y écrit un texte d'information (optionnel)
Close #1 'On ferme le fichier texte créé

    ' second test, celui du repertoire extraction pour verifier qu'il soit vide
Dim presence_fichiers, test As String
Dim nombr As Integer

presence_fichiers = "C:\Dropbox\- Comité des anciens\extractions (à nettoyer)\*.*"
test = "Mauvais"
Do While test = "Mauvais"
If Len(presence_fichiers) > 0 And Len(Dir(presence_fichiers, vbHidden)) > 0 Then
      MsgBox "Attention le répertoire des extractions n'est pas vide !" & (Chr(10)) & "Je vais ouvrir le répertoire pour vous permettre de le vider", vbOKOnly
      Shell Environ("WINDIR") & "\explorer.exe " & "C:\Dropbox\- Comité des anciens\extractions (à nettoyer)\", vbNormalFocus
    
      ' mise en route timer pour attendre les manips
      'RunTime = Now + TimeValue(Format(Int(TimerDurationInSeconds / 3600), "00") & ":" & _
      '                        Format(Int((TimerDurationInSeconds - Int(TimerDurationInSeconds / 3600) * 3600) / 60), "00") & ":" & _
      '                        Format(TimerDurationInSeconds Mod 60, "00"))
  
         Else
      test = "Bon"
      MsgBox "Merci le répertoire des extractions est actuellement vide ;-))" & (Chr(10)) & "vous pouvez continuer sans risques, merci", vbOKOnly
      'Application.OnTime EarliestTime:=RunTime, Procedure:="RunTimer", Schedule:=True
End If
Loop

End Sub

didus · 2 Avril 2022

Une demie solution pas terrible, intervertir les deux lignes entre l'alerte et l'ouverture de l'explorateur ce qui fait que l’explorateur cache l'alerte, par contre il est possible de ne plus comprendre pourquoi l'explorateur s'ouvre...

Shell Environ("WINDIR") & "\explorer.exe " & "C:\Dropbox\- Comité des anciens\extractions (à nettoyer)\", vbNormalFocus
MsgBox "Attention le répertoire des extractions n'est pas vide !" & (Chr(10)) & "Je vais ouvrir le répertoire pour vous permettre de le vider", vbOKOnly

XL 2016 Macros Excel, attendre la fermeture d'un répertoire avant de continuer le code

didus

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

didus

XLDnaute Occasionnel

didus

XLDnaute Occasionnel

didus

XLDnaute Occasionnel

Discussions similaires