[VBA] Le fichier est-il déjà en cours d'utilisation sur le réseau ? Et par qui ?

En réseau, avant de tenter l'ouverture d'un fichier, il est parfois utile de savoir si ce dernier est déjà en cours d'utilisation (ouvert en écriture) et éventuellement par qui.

 

Ci-dessous deux fonctions personnalisées (avec utilisation de l'API Windows) pour répondre à ces questions :

 

Ces fonctions sont issues de l'excellent site The XcelFiles de Ivan F Moala (nb: malheureusement, le site d'Ivan semble avoir disparu fin 2012. C'est un très grand regret pour moi et je laisse quand même le lien au cas où... !)

 

Option Explicit 
 
Private Declare Function knlOpen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long 
Private Declare Function knlClose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long 
 
Sub Test() 
Dim Chemin$ 
Dim EnCoursModif As Boolean 
    'Chemin et fichier à adapter... 
    Chemin = "C:\Partage\Classeur1.xls" 
    'Test d'utilisation sur le réseau 
    EnCoursModif = FichierDejaOuvert(Chemin) 
    'Information utilisateur 
    If EnCoursModif Then 
        MsgBox "Fichier en cours d'utilisation par " & Utilisateur(Chemin) 
    Else 
        MsgBox "Fichier disponible en écriture !" 
    End If 
End Sub 
 
Private Function FichierDejaOuvert(Chemin$) As Boolean 
'Le fichier est-il déjà en cours d'utilisation sur le réseau (en écriture) ? 
Dim hdlFichier&, vErreur& 
    hdlFichier = -1 
    'Ouvrir le fichier en mode Exclusif 
    hdlFichier = knlOpen(Chemin, &H10) 
    'Si ouverture impossible, on récupère le code Erreur correspondant 
    If hdlFichier = -1 Then 
        vErreur = Err.LastDllError 
    Else 
        'On referme le fichier 
        knlClose (hdlFichier) 
    End If 
    FichierDejaOuvert = (hdlFichier = -1) And (vErreur = 32) 
End Function 
 
Private Function Utilisateur$(Chemin$) 
'Commentaire original de Ivan F Moala : 
'// Code by Helen from http://www.visualbasicforum.com/index.php?s= 
'// This routine gets the Username of the File In Use 
'// Credit goes to Helen for code & Mark for the idea 
'// Insomniac for xl97 inStrRev 
'// Amendment 25th June 2004 by IFM 
'// : Name changes will show old setting 
'// : you need to get the Len of the Name stored just before 
'// : the double Padded Nullstrings 
Dim Chaine$, T1$, T2$ 
Dim V1%, V2%, i% 
Dim hdlFichier& 
    T1 = Chr(0) & Chr(0) 
    T2 = Chr(32) & Chr(32) 
    hdlFichier = FreeFile 
    Open Chemin For Binary As #hdlFichier 
        Chaine = Space(LOF(hdlFichier)) 
        Get 1, , Chaine 
    Close #hdlFichier 
    V2 = InStr(1, Chaine, T2) 
    #If Not VBA6 Then 
        'pour Excel 97 
        For V1 = V2 - 1 To 1 Step -1 
            If Mid(Chaine, V1, 1) = Chr(0) Then Exit For 
        Next 
        V1 = V1 + 1 
    #Else 
        'pour Excel 2000 et + 
        V1 = InStrRev(Chaine, T1, V2) + Len(T1) 
    #End If 
    Utilisateur = Mid(Chaine, V1, Asc(Mid(Chaine, V1 - 3, 1))) 
End Function

 

Cette Q&R a été trouvée sur myDearFriend! Excel Pages : https://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqid=47