Lu76Fer
XLDnaute Occasionnel
Disponibilité d'un fichier
I - Présentation du sujet
L'objectif de ce sujet est de proposer une méthode pour attendre qu'un fichier généré par un processus externe soit présent et disponible de façon exclusive, c'est à dire qu'il n'existe aucune opération de lecture ou d'écriture sur celui-là.
Fonction permettant de vérifier qu'un fichier quelconque est disponible :
VB:
Function IsFileOpen(fullFileName As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open fullFileName For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error errnum
End Select
End FunctionCet algorithme fonctionne bien lorsqu'on lit un fichier depuis un classeur Excel pour résoudre un accès concurrentiel à ce fichier. Cependant, il n'est pas du tout efficace pour s'assurer de la disponibilité d'un fichier généré par un autre programme qu'Excel !
Le principal soucis c'est qu'un programme externe qui génère un fichier ne verrouille pas toujours l'accès à ce fichier en cours d'écriture pour les processus sollicitant un accès en lecture. Du coup, il est possible de lire ce fichier en cours d'écriture et d'arriver à la fin du fichier avant la fin de l'écriture complète de celui-ci. Ainsi on se retrouve avec un fichier que partiellement traité ! C'est un problème que j'ai eu et je propose cette fonction modifiée pour pallier à ceci en demandant un accès en écriture : Open fullFileName For Input Lock Write.
Fonction permettant de vérifier qu'un fichier quelconque est présent et disponible :
VB:
'Vrai si le fichier existe et n'est pas déjà ouvert en écriture
Function IsFileAvailable(fullFileName As String) As Boolean
Dim filenum%, errnum%
On Error Resume Next
filenum = FreeFile()
Open fullFileName For Input Lock Write As #filenum 'Demande l'ouverture en bloquant l'accès en écriture
Close filenum: errnum = Err
If errnum = 0 Then IsFileAvailable = True: Exit Function
If errnum = 53 Or errnum = 70 Then Exit Function 'Si Fichier inexistant ou déjà ouvert en écriture
Error errnum 'Sinon Remonte toute autre erreur
End Function
'Algo exemple
Sub TraitementFichier
Do Until IsFileAvailable("C:\Temp\Mon Fichier.txt")
{Attente d'1/4 de seconde}
DoEvents
Loop
{Traitement}
End SubAinsi, on ne peut traiter le fichier qu'une fois que celui-ci a été totalement écrit.
II - Mise en pratique
Lancement d'une recherche sous DOS et attente des résultats à l'aide d'une fonction de rappel pour afficher le suivi du traitement en guise de sablier. Pour paramétrer ce test il y a des constantes en haut du module Code puis il suffit de lancer la procédure RunCmdDir depuis VBE.
La fonction d'appel FindDosFilesWaiting permet d'afficher un message dans la fenêtre d'exécution pour faire patienter l'utilisateur et est appelée en boucle par la fonction de recherche FindDosFiles. Elle pourra utiliser des variables locales initialisées depuis la procédure de départ RunCmdDir au sein d'un tableau de variant qui est transmis par référence via FindDosFiles.
Pour simplifier l'utilisation des variables elles sont nommées à l'aide de constante ainsi :
VB:
Function FindDosFilesWaiting(ByRef vals As Variant) As Boolean
Const VAR_MSG = 0, VAR_SEQ = 1, VAR_TOT = 2
(...) vals(VAR_MSG) (...) vals(VAR_SEQ)
(...) vals(VAR_TOT) (...)La fonction peut aussi permettre d'interrompre la recherche DOS en renvoyant True. Pour tester l'interruption il suffit d'adapter la constante CANCEL_TIME en la réduisant.
Si vous souhaitez tester ce code, téléchargez le fichier joint.
Dernière édition: