[AC-2007] Controle si fichier excel ouvert [Résolu]

[Marcopololo]

Bonjour,

J'utilise la fonction de caféine ci dessous pour vérifier que le fichier d'export excel que je créer dans mon formulaire n'est pas déjà ouvert.
Cette fonction est censée fermer le fichier si j'ai bien compris son utilisation.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    On Error Resume Next
 
    fic = FreeFile()
    Open strFic For Input Access Read Lock Read Write As fic
 
    If Err.Number = 0 Then
        IsFileOpen = False
        Close fic
    Else
        IsFileOpen = True
    End If
End Function

Et voilà le code dans mon formulaire

Code :

IsFileOpen (NameExcel & ".xls")

Mais j'ai une erreur de permission refusée ?

Merci de votre aide

Marcopololo

[helas]

Bonjour,
Cette fonction indique seulement si le fichier est ouvert ou non mais ne le ferme pas

[Marcopololo]

La fonction close ne sert pas à cela ?

J'ai testé en mettant des msgbox et même si j'ai un fichier ouvert au même nom cela me renvoi la valeur 0 puis 1 à chaque fois.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    MsgBox fic, vbOKOnly             ' donne 0
    On Error Resume Next
   MsgBox "demarrage fonction", vbOKOnly
   MsgBox strFic, vbOKOnly   'Si mon fichier s'appelle ff.xls j'ai bien ce nom dans cette variable
    fic = FreeFile()
    MsgBox fic, vbOKOnly            'donne toujours 1 même si fichier ouvert
    Open strFic For Input Access Read Lock Read Write As fic
 
    MsgBox Err.Number, vbOKOnly     'Donne toujours l'erreur 53 fichier ouvert ou pas
        If Err.Number = 0 Then
        IsFileOpen = False
        MsgBox "fichier ouvert", vbOKOnly          'n'apparait jamais
        Close fic
    Else
        IsFileOpen = True
    End If
End Function

J'ai mis des annotations indiquant le comportement es msgbox.
J'ai rajouté une msgbox juste après Open et j'ai toujours le code 53 (fichier introuvable), ce qui veut dire qu'il ne trouve pas mon fichier même ouvert.
Je vais chercher du côté problème de syntaxe du nom du fichier.
Vérification faite mon nom de fichier est bien pris en compte mais je n'ai pas d'erreur 0

[LedZeppII]

Bonjour,

Comme l'a dit helas, la fonction ne ferme pas le fichier.

La fonction close ne sert pas à cela ?

Non.
Elle sert juste à fermer le fichier si l'instruction Open a pu l'ouvrir avec succès.
C'est justement le succès d'ouverture qui veut dire que le fichier n'était pas déjà ouvert par Excel.

Concernant l'erreur 53 (Fichier introuvable), est-ce que tu fournis bien le chemin complet ?
Ex : C:\Documents and Settings\Moi\Mes documents\ff.xlsx

A+

[Marcopololo]

Non effectivement je ne fournis pas le chemin. Je viens de modifier c'est mieux, je passe par ma fonction if mais je vais poursuivre, je crois que ma fonction n'est pas placée au bon endroit.
Je vous tiens informés.

Merci LedzeppII

[Marcopololo]

J'ai modifié ma fonction mais elle bug encore.

La première fois tout se passe à peu près bien si je tente d'enregidtré le même fichier mais la seule chose, les feuilles se ferment bien mais pas l'application Excel, il me reste une page sans fichier ouvert.
Puis la seconde fois, j'ai une erreur car mon fichier ne se ferme pas et il est impossible de l'enregistrer???

Code :

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
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    MsgBox fic, vbOKOnly
    On Error Resume Next
   MsgBox "demarrage fonction", vbOKOnly
   MsgBox strFic, vbOKOnly
    fic = FreeFile()
    MsgBox fic, vbOKOnly
    Open strFic For Input Access Read Lock Read Write As fic
   MsgBox Err.Number, vbOKOnly
    If Err.Number = 0 Then
        IsFileOpen = False
        MsgBox "fichier fermé", vbOKOnly
        Close fic
    Else
        IsFileOpen = True
        MsgBox "fichier ouvert", vbOKOnly
        'Ferme le classeur
        'Workbooks.Close FileName:=strFic
        ActiveWorkbook.Close
        MsgBox "fichier est fermé", vbOKOnly
    End If
 
        'Suppression fichier existant
        If Dir(strFic) <> "" Then Kill strFic
End Function

[LedZeppII]

Bonjour,

Comment est-ce que le fichier Excel est ouvert ?

Voila comment je ferai (avec la fonction IsFileOpen de la faq) si le fichier a été ouvert par l'utilisateur :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub TestFermerFichierXL()
Dim strFichierXL As String
Dim xlWbk As Excel.Workbook
Dim xlApp As Excel.Application
 
    strFichierXL = "C:\Documents and Settings\Moi\Mes documents\ff.xlsx"
 
    If IsFileOpen(strFichierXL) Then
       ' Obtenir un objet WorkBook sur le fichier déjà ouvert
       Set xlWbk = GetObject(strFichierXL)
       ' Récupérer la référence à l'objet Application d'Excel
       Set xlApp = xlWbk.Application
       ' Fermer le classeur avec suvegarde
       xlWbk.Close True
       Set xlWbk = Nothing
       ' Fermer Excel s'il n'y a plus aucun classeur actif
       If xlApp.ActiveWorkbook Is Nothing Then
          xlApp.Quit
          Set xlApp = Nothing
       End If
    End If
End Sub

A+

[Marcopololo]

Cette routine il faut la mettre dans un module telle qu'elle ou la mettre dans la procédure.
En la mettant dans la procédure cela me donne une erreur dans le getobject.

[Marcopololo]

Voilà la fonction complète et qui fonctionne

Merci LedZeppII . Sans toi je crois que je n'y serais pas arrivé avant un bon moment.
Reste plus qu'un petit soucis de compatibilité des fichiers excel. Je vais fouiller un peu.

Voici le code si cela peut intéresser quelqu'un

Code :

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
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    Dim xlWbk As Excel.Workbook
    Dim xlApp As Excel.Application
 
 
    On Error Resume Next
     fic = FreeFile()
     Open strFic For Input Access Read Lock Read Write As fic
       If Err.Number = 0 Then
        IsFileOpen = False
          Close fic
        Else
        End If
 
        ' Obtenir un objet WorkBook sur le fichier déjà ouvert
       Set xlWbk = GetObject(strFic)
        ' Récupérer la référence à l'objet Application d'Excel
       Set xlApp = xlWbk.Application
       ' Fermer le classeur avec suvegarde
       xlWbk.Close True
       Set xlWbk = Nothing
       ' Fermer Excel s'il n'y a plus aucun classeur actif
         If xlApp.ActiveWorkbook Is Nothing Then
             xlApp.Quit
             Set xlApp = Nothing
         End If
 
        'Suppression fichier existant
 
        If Dir(strFic) <> "" Then Kill strFic

Et dans la procédure

Code :

1
2
3
4
5
6
7
  ' Nom complet du fichier excel
 
                strxlfile = "d:\Access 2007\" & NameExcel & ".xls"
 
                'Controle si fichier Excel ouvert et Suppression avant export si existe
 
                   IsFileOpen (strxlfile)

[LedZeppII]

Envoyé par Marcopololo

Cette routine il faut la mettre dans un module telle qu'elle ou la mettre dans la procédure.
En la mettant dans la procédure cela me donne une erreur dans le getobject.

Ma procédure n'est pas à intégrer dans la fonction IsFileOpen, mais elle utilise IsFileOpen.
Elle sert juste à montrer comment exploiter le résultat de IsFileOpen, et agir en conséquence.
Voila mon code complet:

Code :

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
Sub TestFermerFichierXL()
Dim strFichierXL As String
Dim xlWbk As Excel.Workbook
Dim xlApp As Excel.Application
 
    strFichierXL = "C:\Documents and Settings\Moi\Mes documents\ff.xlsx"
 
    If IsFileOpen(strFichierXL) Then
       ' Obtenir un objet WorkBook sur le fichier déjà ouvert
       Set xlWbk = GetObject(strFichierXL)
       ' Récupérer la référence à l'objet Application d'Excel
       Set xlApp = xlWbk.Application
       ' Fermer le classeur avec suvegarde
       xlWbk.Close True
       Set xlWbk = Nothing
       ' Fermer Excel s'il n'y a plus aucun classeur actif
       If xlApp.ActiveWorkbook Is Nothing Then
          xlApp.Quit
          Set xlApp = Nothing
       End If
    End If
End Sub
 
 
Function IsFileOpen(ByVal strFic As String) As Boolean
    Dim fic As Integer
    On Error Resume Next
 
    fic = FreeFile()
    Open strFic For Input Access Read Lock Read Write As fic
 
    If Err.Number = 0 Then
        IsFileOpen = False
        Close fic
    Else
        IsFileOpen = True
    End If
End Function

Pour rendre variable le nom de fichier il suffit de mettre strFichierXL en argument, de supprimer la déclaration de strFichierXL ainsi que la ligne d'affection à strFichierXL.
On en profite pour renommer la sub avec nom plus parlant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub FermerFichierXLsiOuvert(strFichierXL As String)
Dim xlWbk As Excel.Workbook
Dim xlApp As Excel.Application
 
    If IsFileOpen(strFichierXL) Then
       ' Obtenir un objet WorkBook sur le fichier déjà ouvert
       Set xlWbk = GetObject(strFichierXL)
       ' Récupérer la référence à l'objet Application d'Excel
       Set xlApp = xlWbk.Application
       ' Fermer le classeur avec suvegarde
       xlWbk.Close True
       Set xlWbk = Nothing
       ' Fermer Excel s'il n'y a plus aucun classeur actif
       If xlApp.ActiveWorkbook Is Nothing Then
          xlApp.Quit
          Set xlApp = Nothing
       End If
    End If
End Sub

Le code que tu as posté ici a l'inconvénient d'ouvrir le fichier avec GetObject, même si celui-ci n'était pas ouvert.
Par ailleurs, tu ne verras aucune erreur à cause de On Error Resume Next.

J'écrirai la fonction (sous un autre nom) de cette manière :

Code :

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
Function SupprimerFichierExcel(ByVal strFic As String) As Boolean
    Dim fic As Integer, bIsOpen As Boolean
    Dim xlWbk As Excel.Workbook
    Dim xlApp As Excel.Application
 
    ' Quitter si le fichier n'existe pas
    If Dir(strFic) = "" Then
       SupprimerFichierExcel = False
       Exit Function
    End If
 
    ' Ignorer les erreurs
    On Error Resume Next
 
    ' Cherche si le fichier est ouvert
    fic = FreeFile()
    Open strFic For Input Access Read Lock Read Write As fic
    If Err.Number = 0 Then
        bIsOpen = False
        Close fic
    Else
        bIsOpen = True
    End If
    ' rétablit l'affichage des erreurs
    On Error GoTo 0
 
    ' Si le fichier est ouvert
    If bIsOpen Then
       ' Obtenir un objet WorkBook sur le fichier déjà ouvert
       Set xlWbk = GetObject(strFichierXL)
       ' Récupérer la référence à l'objet Application d'Excel
       Set xlApp = xlWbk.Application
       ' Fermer le classeur avec suvegarde
       xlWbk.Close True
       Set xlWbk = Nothing
       ' Fermer Excel s'il n'y a plus aucun classeur actif
       If xlApp.ActiveWorkbook Is Nothing Then
          xlApp.Quit
          Set xlApp = Nothing
       End If
    End If
 
    'Suppression fichier existant
    If Dir(strFic) <> "" Then Kill strFic
    SupprimerFichierExcel = True
End Function

A+