Bonjour,

J'ai plusieurs fichiers Excel qui, lorsque qu'il s'ouvrent créer un répertoire (le même pour tous) sauf si le dossier est déjà créer (afin d'éviter d'écraser tous les fichier qui se trouveraient à l'intérieur). Lorsque ces fichiers se ferment, ils suppriment ce dossier sauf si un autre fichier Excel du même répertoire est ouvert.

Le problème que j'ai c'est que ces fichiers se trouvent sur un serveur et que chaque fichier peut être ouvert plusieurs fois en même temps (j'ai fais le test). Vu que je fais un test sur le nom du fichier et que celui-ci peut être ouvert plusieurs fois je cherche une solution afin d'exclure le fichier ouvert sur un poste de travail.

Je m'explique, si je suis le seul à avoir un fichier Excel ouvert, je voudrait que le dossier se supprime. Or je fais un test sur le nom du fichier et donc mon répertoire ne se supprime pas car le fichier est ouvert.

Remarque : je fais également un test sur le nombre de fichier Excel ouvert sur un poste de travail. Si il y a plus d'un fichier Excel ouvert, je fais un test sur chaque nom de fichier. Cela fonctionne si je n'ai pas d'autres fichiers Excel ouvert (qui n'ont rien à voir avec tous ces fichiers Excel).

Je cherche donc un bout de code, soit me permettant de ne pas prendre en compte le fichier ouvert sur un poste poste, soit de compter le nombre de fichiers ouverts portant le même nom et si ce nombre est égale à 1 alors je supprime le répertoire, sinon non, soit de compter le nombre de fichier Excel ouvert dans un répertoire spécifique.

Voici mon code :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
 
Sub SupprDossier()
 
Dim FS
Dim TestPath, TestPath2, Chemin, Chemin2, NomFich As String
 
Chemin = ThisWorkbook.Path
Chemin2 = Left(Chemin, InStr(Chemin, "\")) 
 
'Récupération du nom du lecteur réseau (peut changé en fonction du poste 'de travail)
 
NomFich = "Repertoire"
 
TestPath = Chemin2 & NomFich
 
If (TestPath2 = Dir(TestPath, vbDirectory)) = vbEmpty Then
 
    If Workbooks.Count > 1 Then
         If FichierEstOuvert(Chemin2 & "test\toto1.xls") = False Then
              If FichierEstOuvert(Chemin2 & "test\toto2.xls") = False Then
              'etc.
                  Set FS = CreateObject("Scripting.FileSystemObject")
                  FS.Deletefolder TestPath
                  Exit Sub
 
              End If
         End If
 
    Else
 
        Set FS = CreateObject("Scripting.FileSystemObject")
        FS.Deletefolder TestPath
        Exit Sub
 
    End If
 
End If
 
End Sub
J'ai oublié de mettre le code de la fonction FichierEstOuvert, le voici :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Function FichierEstOuvert(ByRef FichierTest As String) As Boolean
 
Dim Fichier As Long
 
On Error GoTo Erreur
Fichier = FreeFile
Open FichierTest For Input Lock Read As #Fichier
Close #Fichier
FichierEstOuvert = False
Exit Function
Erreur:
    FichierEstOuvert = True
End Function