Visual basic - Tester si un fichier est ouvert

Version imprimable

20/02/2014, 10h16
juliep

Bonjour,

Je suis assez nulle en visual basic et voilà, je dois reprendre un code existant en y ajoutant des améliorations.
Globalement, l'objectif du code VB est de déclencher une application stockée SAS sur un serveur workspace et de tracer l'éxécution dans un fichier log.

La première chose que fait le code, c'est d'ouvrir le fichier log (.log) et de tracer la date et les informations globales. Il peut y avoir plusieurs utilisateurs simultanément.
Problématique : Je souhaiterais tester si le fichier log est déjà ouvert au moment de l'éxecution du code. Si le fichier est ouvert, attendre 15s (ou un certain temps) et renouveller le test. Si le fichier log n'est pas ouvert, écrire les infos globales et le reste.

Est-ce possible de faire ça ?
Si oui, comment ?

Merci d'avance pour votre aide.

Je voudrais juste rajouter que je cherche à initier une boucle Tant que :
Tant que le fichier est ouvert, attendre
Quand le fichier n'est pas ouvert, écrire dans le fichier

merci pour votre aide.

:salut:
J'ai trouvé un code en VB, mais je ne sais pas s'il y a un équivalent en Vbscript ? :roll:

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
Sub ChkFileStatus()
 
    ' Test to see if the file is open.
    If IsFileOpen("c:\Test.xls") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
    End If
 
End Sub
 
' This function checks to see if a file is open or not.
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
 
    On Error Resume Next
    filenum = FreeFile()
 
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
 
    ' Check to see which error occurred.
    Select Case errnum
 
        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False
 
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True
 
        ' Another error occurred.
        Case Else
            Error errnum
    End Select
 
End Function

Merci pour cette première réponse.
C'est en effet le code que j'ai trouvé également, mais plusieurs points :
¤ Il n'y a pas le notion de tant que le fichier est ouvert = la fonction sleep peut-être mais attendre que le fichier soit fermé avant d'aller écrire dedans
¤ lorsque je tester simplement ce bout de code, j'ai l'erreur 53 qui apparait. En cherchant, cette erreur traduit le fait que le fichier est introuvable, or j'ai fait le test avec un petit fichier direment à la racine C:\ et cela ne marche pas. Même quand le fichier est fermé.

Voilà mon

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Declare Sub Sleep Lib "Kernel32.dll" (ByVal dwMillisenconds As Long)
Sub main()
 
    ' Déclare la fonction sleep
 
 
    ' Si le fichier est ouvert.
    If IsFileOpen("E:\essai.txt") Then
    Call Sleep(15000)
    MsgBox "OUVERT"
 
 
   'GoTo 121
 
    ' Si le fichier n'est pas déjà ouvert.
    Else
    Call Sleep(15000)
    MsgBox "FERME"
 
 
    End If
 
End Sub
 
 
' Cette fonction vérifie si le fichier est ouvert ou non.
' Si le fichier est déjà ouvert, elle retourne True.
' Si le fichier n'est pas ouvert, elle retourne False.
' Autrement, une erreur d'exécution s'est produit liée
' à un autre problème d'accès au fichier.
 
Function IsFileOpen(filename As String) As Boolean
    Dim filenum As Long, errnum As Long
 
    On Error Resume Next   ' Si erreur, passe à l'instruction qui suit directement celle qui a engendré l'erreur d'exécution .
    filenum = FreeFile()   ' Obtient un numéro de fichier.
    ' Tente d'ouvrir le fichier.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Ferme le fichier.
    errnum = Err.Number    ' Enregistre le numéro de l'erreur produite.
    On Error GoTo 0        ' Désactive la gestion des erreurs dans la procédure actuelle.
 
    ' On regarde quelle erreur s'est produite.
    Select Case errnum
 
        ' Aucune erreur.
        ' le fichier n'est PAS déjà ouvert.
        Case 0
         IsFileOpen = False
 
        ' Erreur 70 "Permission Denied."
        ' Le fichier est déjà ouvert.
        Case 70
            IsFileOpen = True
 
        ' Une autre erreur s'est produite.
        Case Else
            Error errnum
    End Select
 
 
End Function

la fonction sleep fonctionne bien et me donne le résultat attendu. Je mettrai un goto pour faire une bouble fermée.
Mais mon problème c'est que le programme reste toujours dans le cas où le fichier est fermé, même si mon fichier est ouvert.
Savez-vous d'où vient l'erreur ?

J'ai une autre proposition qui pourrait peut-être satisfaire la demande :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Declare Function lOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lClose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
 
Private Function IsFileInUse(FileName As String) As Boolean
    Dim hFile As Long
    Dim lastErr As Long
    ' Initialisation du handle et de la variable d'erreur
    hFile = -1
    lastErr = 0
    ' Ouvre le fichier en mode lecture et partage exclusif.
    hFile = lOpen(FileName, &H10)
    ' Si ne peut ouvrir le fichier, obtient la dernière erreur(lastErr).
    If hFile = -1 Then
        lastErr = Err.LastDllError
    Else
         ' S'assurer qu'on a bien fermé le fichier en cas de succès.
        lClose (hFile)
    End If
    ' Vérifie s'il y a ou non violation de partage.
    IsFileInUse = (hFile = -1) And (lastErr = 32)
End Function

16/03/2015, 19h19
DarkVader

Bonsoir,
Cela se fait très simplement avec IsBusy(nom_du_fichier) de la librairie VB6i