Classeur "ouvert" en lecture seul

Salut,

J'utilise un code qui me dit si tel fichier est ouvert ou non.

Le problème c'est que le code ne détecte pas si le fichier est ouvert en lecture seul ou non.

J'aimerais qu'il le détecte comme non ouvert si ouvert seulement en lecture seul.

C'est possible?

Sub ouvrir_numero_projet()

    Dim Verification As Boolean
    Dim MonClasseur As String

    MonClasseur = "Z:\COMMANDES D'ACHATS\1-NUMÉROS DE PROJETS.xlsm"

    'd'abord le test si le fichier existe
    If Len(Dir(MonClasseur)) = 0 Then            's'il n'existe pas, montrer un avertissement et quitter la macro
        MsgBox "ERREUR: Le Classeur: [" & MonClasseur & "] n'existe pas..."
        Exit Sub
    Else
    End If

    'si le Classeur existe, vérifier s'il est déjà ouvert
    Verification = EstClasseurOuvert(MonClasseur)

    If Verification = True Then
        MsgBox "LE # PROJETS EST DÉJÀ OUVERT"
    Else
        On Error Resume Next
        Workbooks.Open Filename:="Z:\COMMANDES D'ACHATS\1-NUMÉROS DE PROJETS.xlsm"
        Workbooks("1-NUMÉROS DE PROJETS.xlsm").Worksheets("Soumissions").Activate
    End If

End Sub

Function EstClasseurOuvert(MonClasseur As String)

    Dim NumeroFichier As Long, NumeroErreur As Long

    On Error Resume Next
    NumeroFichier = FreeFile()
    Open MonClasseur For Input Lock Read As #NumeroFichier
    Close NumeroFichier
    NumeroErreur = Err
    On Error GoTo 0

    Select Case NumeroErreur
    Case 0:    EstClasseurOuvert = False
    Case 70:   EstClasseurOuvert = True
    Case Else: Error NumeroErreur
    End Select
End Function

Merci!

Bonjour jbeaudoin

Ouille youille, n'y aurait-il pas un petit mélange de neurone

Un fichier ouvert est forcément en lecture seul à moins de l'avoir mis en partage (donc pas de problème)

Et vous nous dites "J'aimerais qu'il le détecte comme non ouvert si ouvert seulement en lecture seul"

Merci de revoir votre demande SVP

Bonjour,

@BrunoM45

Euh ... désolé, mais a priori un fichier non partagé n'est pas ouvert en lecture seule sauf s'il a été enregistré en lecture seule recommandée.

@Jbeaudoin

Une proposition avec ces 3 fonctions :

Function IsFileOpenForReadOnly(ByVal nom_fichier As String) As Boolean

    If IsFileOpen(nom_fichier) And Not IsFileOpenForWrite(nom_fichier) Then
        IsFileOpenForReadOnly = True
    Else
        IsFileOpenForReadOnly = False
    End If

End Function

Function IsFileOpen(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read As #no_fichier
    If Err.Number = 0 Then IsFileOpen = False _
    Else IsFileOpen = True
    Close no_fichier

End Function

Function IsFileOpenForWrite(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read Write As #no_fichier
    If Err.Number = 0 Then IsFileOpenForWrite = False _
    Else IsFileOpenForWrite = True
    Close no_fichier

End Function

Salut,

@BrunoM45 À l'ouverture de ce fichier, non partagé, on peut choisir entre l'ouvrir en lecture seul ou pas.

@thev Le code semble fonctionner mais si le fichier est ouvert (en écriture) par un de mes collègues il ouvre le fichier en lecture seul. Je comprend pas..

Voici le code à jour

Sub ouvrir_numero_projet()

    Dim nom_fichier As String
    nom_fichier = "Z:\COMMANDES D'ACHATS\1-NUMÉROS DE PROJETS.xlsm"
    Dim Verification As Boolean

    'd'abord le test si le fichier existe
    If Len(Dir(nom_fichier)) = 0 Then            's'il n'existe pas, montrer un avertissement et quitter la macro
        MsgBox "ERREUR: Le Classeur: [" & nom_fichier & "] n'existe pas..."
        Exit Sub
    Else
    End If

    'si le Classeur existe, vérifier s'il est déjà ouvert
    Verification = IsFileOpenForReadOnly(nom_fichier) 'Verification = EstClasseurOuvert(MonClasseur)

    If Verification = True Then
        MsgBox "LE # PROJETS EST DÉJÀ OUVERT"
    Else
        On Error Resume Next
        Workbooks.Open Filename:=nom_fichier, IgnoreReadOnlyRecommended:=True
        Workbooks("1-NUMÉROS DE PROJETS.xlsm").Worksheets("Soumissions").Activate
    End If

End Sub

Function IsFileOpenForReadOnly(ByVal nom_fichier As String) As Boolean

    If IsFileOpen(nom_fichier) And Not IsFileOpenForWrite(nom_fichier) Then
        IsFileOpenForReadOnly = True
    Else
        IsFileOpenForReadOnly = False
    End If

End Function

Function IsFileOpen(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read As #no_fichier
    If Err.Number = 0 Then IsFileOpen = False _
    Else IsFileOpen = True
    Close no_fichier

End Function

Function IsFileOpenForWrite(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read Write As #no_fichier
    If Err.Number = 0 Then IsFileOpenForWrite = False _
    Else IsFileOpenForWrite = True
    Close no_fichier

End Function

Le code semble fonctionner mais si le fichier est ouvert (en écriture) par un de mes collègues il ouvre le fichier en lecture seul. Je comprend pas..
Après vérif, en fait tout ce qui peut être testé, c'est lorsque le fichier est ouvert en écriture. Un fichier ouvert en lecture seule n'est pas détecté.

Donc votre code doit être :

Sub ouvrir_numero_projet()

    Const nom_fichier As String = "Z:\COMMANDES D'ACHATS\1-NUMÉROS DE PROJETS.xlsm"
    Dim Verification As Boolean

    'd'abord le test si le fichier existe
    If Len(Dir(nom_fichier)) = 0 Then            's'il n'existe pas, montrer un avertissement et quitter la macro
        MsgBox "ERREUR: Le Classeur: [" & nom_fichier & "] n'existe pas..."
        Exit Sub
    End If

    'vérifier si le classeur n'est pas ouvert en écriture
    Verification = IsFileOpenForWrite(nom_fichier) 'Verification = EstClasseurOuvert(MonClasseur)

    If Verification = True Then
        MsgBox "LE # PROJETS EST DÉJÀ OUVERT EN ÉCRITURE"
    Else
        On Error Resume Next
        Workbooks.Open fileName:=nom_fichier, IgnoreReadOnlyRecommended:=True
        Workbooks("1-NUMÉROS DE PROJETS.xlsm").Worksheets("Soumissions").Activate
    End If

End Sub

Function IsFileOpenForWrite(ByVal nom_fichier As String) As Boolean
    Dim no_fichier As Long

    On Error Resume Next
    no_fichier = FreeFile()
    Open nom_fichier For Binary Access Read Lock Read Write As #no_fichier
    If Err.Number = 0 Then IsFileOpenForWrite = False _
    Else IsFileOpenForWrite = True
    Close no_fichier

End Function

Ça fonctionne parfaitement! Merci!