Discussion :

[JeanSairien]

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

[JeanSairien]

Est-ce que quelqu'un aurait un bout de code qui permet de compter le nombre de fichiers Excel ouvert dont le chemin d'accès est le même (même répertoire)?

J'ai trouvé un bout de code pour compter le nombre de fichiers dans un répertoire, mais moi je souhaiterais comptr le nombre de fichier ouvert.

En vous remerciant par avance,

Cordialement,

JeanSairien

[JeanSairien]

J'ai trouvé une solution, mais je doit entrer à la main le nom des sous répertoire.

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Sub SupprDossier()
 
Dim fs
Dim TestPath, TestPath2, Chemin, Chemin2, NomFich, NomFich2 As String
Dim test, test2 As String
 
Dim i As Integer
 
Dim fso, fil As Object
 
Chemin = ThisWorkbook.Path
Chemin2 = Left(Chemin, InStr(Chemin, "\"))
NomFich = "dossier"
NomFich2 = Chemin2 & "dossier2"
 
TestPath = Chemin2 & NomFich
 
i = 0
 
Set fso = CreateObject("Scripting.FilesystemObject")
 
If (TestPath2 = Dir(TestPath, vbDirectory)) = vbEmpty Then
 
    For Each fil In fso.GetFolder(NomFich2 & "\Sous_dossier1").Files
 
        test2 = fil.Name
        If FichierEstOuvert(fil.Path) = False Then
 
        Else
 
            i = i + 1
            MsgBox "Le classeur " & test2 & " est ouvert"
 
        End If
 
    Next
 
    For Each fil In fso.GetFolder(NomFich2 & "\Sous_dossier2").Files
 
        test2 = fil.Name
        If FichierEstOuvert(fil.Path) = False Then
 
        Else
 
            i = i + 1
            MsgBox "Le classeur " & test2 & " est ouvert"
 
        End If
 
    Next
 
    For Each fil In fso.GetFolder(NomFich2 & "\Sous_dossier3").Files
 
        test2 = fil.Name
        If FichierEstOuvert(fil.Path) = False Then
 
        Else
 
            i = i + 1
            MsgBox "Le classeur " & test2 & " est ouvert"
 
        End If
 
    Next
 
    For Each fil In fso.GetFolder(NomFich2 & "\Sous_dossier4").Files
 
        test2 = fil.Name
        If FichierEstOuvert(fil.Path) = False Then
 
        Else
 
            i = i + 1
            MsgBox "Le classeur " & test2 & " est ouvert"
 
        End If
 
    Next
 
    If i = 1 Then
 
        Set fs = CreateObject("Scripting.FileSystemObject")
            fs.Deletefolder TestPath
 
    End If
 
End If
 
End Sub

Si quelqu'un aurait une méthode pour ne pas avoir à entrer le nom de mes 4 sous répertoire et ainsi réduire mon code ce serait génial.

Dans tous les cas avant demain midi je mettrais ce sujet en résolu avec le code de la macro si j'ai trouvé (ou si on m'as donné) la solution.

[mercatog]

Lister les fichiers contenus dans un répertoire ainsi que dans tous ses sous-répertoires

[JeanSairien]

Super merci beaucoup j'ai modifié ma macro et cela fonctionne.

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
41
42
43
44
45
46
47
48
49
50
51
52
 
Sub SupprDossier()
 
Dim fs
Dim TestPath, TestPath2, Chemin, Chemin2, NomFich, NomFich2 As String
Dim test, test2 As String
 
Dim i As Integer
 
Dim fso, fil, SubFldr As Object
 
Chemin = ThisWorkbook.Path
Chemin2 = Left(Chemin, InStr(Chemin, "\"))
NomFich = "Dossier1"
NomFich2 = Chemin2 & "Dossier2"
 
TestPath = Chemin2 & NomFich
 
i = 0
 
Set fso = CreateObject("Scripting.FilesystemObject")
 
If (TestPath2 = Dir(TestPath, vbDirectory)) = vbEmpty Then
 
    For Each SubFldr In fso.getfolder(NomFich2).subfolders
 
        For Each fil In fso.getfolder(SubFldr.Path).Files
 
            test2 = fil.Name
            If FichierEstOuvert(fil.Path) = False Then
 
            Else
 
                i = i + 1
                MsgBox "Le classeur " & test2 & " est ouvert"
 
            End If
 
        Next
 
    Next
 
    If i = 1 Then
 
        Set fs = CreateObject("Scripting.FileSystemObject")
            fs.Deletefolder TestPath
 
    End If
 
End If
 
End Sub

Il me reste plus qu'à faire un test sur fil.name et le nom de mon classeur ouvert et le tour est joué.

Encore merci.