Ouverture fichier bis si fichier principal déjà ouvert par autre user

Bonjour à tous,

Je suis à la recherche d'un code VBA pour la fonction suivante:

Ayant le fichier TEST1 en réseau et utilisé par plusieurs users, je souhaiterais que si un user tente d'ouvrir ce fichier qui serait déjà en utilisation qu'il n'y ait pas le message d'info comme quoi l'utilisateur X est déjà en train de l'utiliser (donc, lecture seule) mais qu'un autre fichier identique nommé TEST2 soit automatiquement ouvert à la place.

C'est-à-dire: "Si fichier TEST1.xlsm est déjà ouvert, ouvrir TEST2.xlsm. Sinon, ouvrir TEST1.xlsm"

J'ai trouvé un code sur ce forum mais il ne marche pas ou en tout cas je ne sais pas le faire marcher (??):

Sub TestFileOpened()

    If IsFileOpen("\\chemin du fichier\ Monfichier.xls") Then

        MsgBox "Attention, le fichier est ouvert par un autre utilisateur ! Fin du traitement Réessayer, plus tard."

    Else        
           ' code de la macro M ou appel vers cette macro            
    End If

End Sub

P.

bonjour,

As-tu bien une fonction qui s'appelle IsFileOpen ?

sinon voici le code à mettre dans ton classeur :

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err
    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

        Case Else
            Error errnum
    End Select

End Function

dans les autres cas, dis-nous quel est le message d'erreur que tu reçois quand tu exécutes la macro.

MERCI H2SO4!

J'ai un doute: cela est inclus dans un module ou dans ThisWorkbook?

Voici donc tout le code que j'ai. A tester.

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err
    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

        Case Else
            Error errnum
    End Select

End Function

Sub TestFileOpened()

    If IsFileOpen("G:\FAB\SCAN FICHIER\FICHIER DE BASE\SCAN OF.xlsm") Then

              On Error GoTo OuvertureFichierErreur
   Dim MonApplication As Object
   Dim MonFichier As String
   Set MonApplication = CreateObject("Shell.Application")

'J'indique le répertoir où trouver le fichier:
   MonFichier = "G:\FAB\SCAN FICHIER\FICHIER DE BASE\SCAN OF2.xlsm"
   MonApplication.Open (MonFichier)

   Set MonApplication = Nothing

' Si le fichier n'existe pas/plus:
OuvertureFichierErreur:
   Set MonApplication = Nothing
    MsgBox "Erreur lors de l'ouverture de fichier.", vbCritical

    End If

End Sub

re-bonjour,

J'ai un doute: cela est inclus dans un module ou dans ThisWorkbook?

dans un module (même si cela devrait fonctionner si la fonction se trouvait dans le même module de feuille ou de classeur).

Si cela ne fonctionne pas, reçois-tu un message ? Lequel ?

Re à toi aussi et merci pour ton retour et surtout pour ton aide :-)

J'ai tout le code dans un même module (donc il n'y a rien sur la feuille ni dans ThisWorkbook). Mais ça ne marche pas. J'ai le message d'erreur de Windows:

"SCAN OF.xlsm est vérouillé pour modification par "user X". Ouvrez le document en utilisant l'option Lecture Seule ou cliquez sur notifier pour ouvrir une copie du document en lecture seule et recevoir une notification lorsque le document sera à nouveau disponible".

- Lecture Seule

- Notifier

- Annuler

En aucun cas j'ai le message inclus dans la macro qui apparaît ni le fichier SCAN OF2.xlsm qui s'ouvre :-(

Bonjour,

je ne pense pas que ce message soit dû à ces codes. C'est un message que l'on reçoit lorsqu'on essaie d'ouvrir un fichier Excel avec workbooks.open. Or je ne vois pas de workbooks.open dans ces codes. Y a-t-il d'autres macros ? Qu'y a-t-il comme macros dans SCAN OF2.xlsm ?

Re,

oui, il y a du code:

Private Sub Workbook_Open()

' Je vais chercher l'utilisateur du PC et je le note dans P2. 

Dim sUserName As String

' Recherche le nom d'utilisateur Windows

sUserName = Environ$("username")

Sheets("SCAN").Range("P2") = sUserName

'Je me situe sur la feuille SCAN:
Sheets("SCAN").Activate

'Je cache la feuille NOMENCLATURE car je ne veux pas qu'elle puisse être activée:
Sheets("NOMENCLATURE").Visible = xlSheetVeryHidden

'J'active ou désactive les boutons de l'entête:

    ActiveSheet.Shapes("bouton2").Visible = False
    ActiveSheet.Shapes("bouton3").Visible = False

ActiveSheet.Shapes("NOUVELLESAISIE").Visible = False
ActiveSheet.Shapes("NOUVELLESAISIEOFF").Visible = True

'Je demande de faire une actualisation de la cellule S3:
Sheets("SCAN").Range("S3").Calculate

'Je cache le petit logo qui s'affiche lors de l'impression du document:
ActiveSheet.Shapes("LOGO").Visible = False

'J'actualise la cellule H12 de DATA:
Sheets("DATA").Activate
Range("H12").Select

Sheets("SCAN").Select

'Je demande à Excel de toujours se situer sur la première cellule vide de la colonne I afin de ne pas écraser des données:
ActiveSheet.Cells(Rows.Count, "I").End(xlUp)(2).Select

End Sub

Ce code fonctionne. Je vais testé ton code sur un dossier neutre voir ci cela me pose aussi problème. Je te redis.

Non, le code ne fonctionne toujours pas même sur un fichier neutre qui n'a que ce module

fichier en annexe.

Puis, j'ai testé ce code mais c'est la même chose, j'ai le message de Windows qui apparaît:

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

Sub Sample()
    Dim xRet As Boolean
    xRet = IsWorkBookOpen("TEST1.xlsm")
    If xRet Then

        On Error GoTo OuvertureFichierErreur
   Dim MonApplication As Object
   Dim MonFichier As String
   Set MonApplication = CreateObject("Shell.Application")

'J'indique le répertoir où trouver le fichier:
   MonFichier = "G:\FAB\SCAN FICHIER\FICHIER DE BASE\TEST2.xlsm"
   MonApplication.Open (MonFichier)

   Set MonApplication = Nothing

' Si le fichier n'existe pas/plus:
OuvertureFichierErreur:
   Set MonApplication = Nothing
    MsgBox "Erreur lors de l'ouverture de fichier.", vbCritical

    End If

bonjour,

cette fonction vérifie si le classeur est déjà ouvert en excel sur ton ordinateur, pas s'il est ouvert par quelqu'un d'autre sur un autre ordinateur.

Function IsWorkBookOpen(Name As String) As Boolean
    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (Not xWb Is Nothing)
End Function

bonjour,

chez moi le code que j'ai fourni fonctionne, donc je ne peux pas en dire davantage sans avoir une vue claire sur tout ton environnement.

Bonjour,

A priori, votre fichier est sur un serveur, votre "G:" est sans doute une unité réseau. Mais cette unité réseau est-elle commune à tous les utilisateurs de ce fichier ?

Bonjour,

effectivement c’est sur une unité en réseau (d’entreprise). Tous les utilisateurs ont accès à ce réseau et c’est là que le fichier est partagé.

Du fait que plusieurs utilisateurs utilisent ce fichier et que ça « bloque » je voulais donner l’option s’ouvrir un fichier alternatif pour ne pas bloquer les employés et qu’ils doivent attendre que le fichier se libère.

Le fait que le fichier soit en réseau causerait problème?

Merci

Bonsoir PatPatrouille, H2so4, Thev,

Pour cela utilises de mini fichiers texte qui agissent comme des Logs d'ouverture et de fermeture du fichier Excel principal.

Crée autant de fichiers texte qu'il y a d'utilisateur de logs à vérifier. Et surtout soit sur le même chemin que celui-ci (mieux), soit sur un chemin spécifique.

Nomme les F_ puis fais suivre ces deux caractères par le nom de l'utilisateur voire son rang d'user.

Puis au Workbook_Open du fichier Excel, à partir du sUserName = Environ$("username")

Chemin = à adapter à l'environnement
FichF = "F_" & sUserName" & .Txt"
FichO = "O_" & sUserName" & .Txt"
Name Chemin & FichF As Chemin & FichO

A la fermeture du classeur par l'utilisateur ce sera l'inverse. Code dans le WorkBook_BeforeClose

sUserName = Environ$("username")
Chemin = à adapter à l'environnement
FichO = "O_" & sUserName" & .Txt"
FichF = "F_" & sUserName" & .Txt"
Name Chemin & FichO As Chemin & FichF

Ainsi par une boucle sur tous les fichiers texte commençant par "O_" (réservé aux logs).

S'il en existe un alors tu ouvres ton fichier secondaire.

S'il n'en existe pas (donc il n'y a que des F_) alors tous les utilisateurs ont fermé leur connexion sur le fichier principal. Tu peux ouvrir celui-ci.

Alors G est pour toute l’entreprise donc elle ne change pas. :-)

Bonjour,