Vérifier si classeur déjà ouvert (fichier distant HTTP)

[s8fx]

Bonjour à tous,

J'ai trouvé un très bon code pour tester si un fichier est ouvert avec gestion des erreurs.

Le pb c'est que le code fonctionne bien en local (C:\xx) ou sur le réseau (quand on connecte un lecteur réseau en lui attribuant une lettre) mais pas en distant (http:// (sans pouvoir monter ce lien en tant que lecteur réseau) )

Ce que je ne comprends car le code se base sur la même variable string (sNomWkb)
Si vous avez une idée pour débuger ce code ou l’améliorer ça serait top

(j'ai cherché sur le forum et internet je ne trouve aucune aide pour utiliser un test comme celui la via http://)

Voici le code :

    Option Explicit
     
            Sub Test()
            Dim i As Integer
            Dim sNomWkb As String
                sNomWkb = "Test.xlsm"
     
                i = VerifClasseur("http://serveur.mondomaine/dossier/2014/" & sNomWkb)
                Select Case i
                    Case 0: MsgBox "Classeur fermé."
                    Case 53:
                        If WOuvert(sNomWkb) = False Then
                            MsgBox "Fichier introuvable"
                        Else
                            MsgBox "Classeur déja ouvert."
                        End If
                    Case 70: MsgBox "Classeur déja ouvert."
                    Case Else: MsgBox "Erreur : " & i
                End Select
            End Sub
     
            Private Function VerifClasseur(Fichier As String) As Integer
            Dim x As Integer
     
                On Error Resume Next
                x = FreeFile()
                Open Fichier For Input Lock Read As #x
                Close x
     
                VerifClasseur = Err.Number
                On Error GoTo 0
            End Function
     
            Private Function WOuvert(sNom As String) As Boolean
            Dim Wkb As Workbook
                WOuvert = False
                For Each Wkb In Workbooks
                    If Wkb.Name = sNom Then
                        WOuvert = True
                        Exit For
                    End If
                Next Wkb
            End Function

Je suis sous XP, dans un domaine AD, sur une plateforme sharepoint 2003 avec Excel 2010.

Merci d'avance pour vos retours

 

[Roland_M]

Re : Vérifier si classeur déjà ouvert (fichier distant HTTP)

bonjour,

s'il s'agit bien d'un classeur et aussi si tu connais le nom alors ceci suffit
For I = 1 To Workbooks.Count
If Workbooks(I).Name = "NomDeTonClasseur" Then MsgBox "le classeur " & Workbooks(I).Name & vbLf & "est ouvert !": exit for
Next

 

[s8fx]

Re : Vérifier si classeur déjà ouvert (fichier distant HTTP)

Effectivement ca fonctionne! Merci

Par contre j'ai un bug car j'ai du mal voir dans mon code les début et fin de procedure.
Contexte : fichier 1 lance la macro de verif si fichier2 ouvert
Voici le PB :
si fichier 2 deja ouvert avant fichier1 alors la macro fonctionne.
si fichier 1 ouvre lui meme fichier2 puis reteste si fichier 2 ouvert alors NOK.

si vous avez une idée, voici mon code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Si Colonne different de 2(=B) alors on sort (Bride la macro sur la seule colonne voulue)
If Target.Column <> 2 Then
Cancel = False
Exit Sub
End If
Dim Recherche As String
'Recherche prend la valeur de la cellule active décalé de 5 vers la droite (0 = meme ligne); ici de B vers G
Recherche = ActiveCell.Offset(0, 5)
'Verifie si le type est autorisé
Select Case Recherche
Case "PC"
'Alors copier la valeur de la cellule double cliquée B vers le fichier2
Dim Brass As Workbook
Dim i As Integer
For i = 1 To Workbooks.Count
If Workbooks(i).Name = "test.xlsm" Then
        MsgBox "test1"
        Set Brass = Workbooks(i)
        Brass.Activate
        Brass.Sheets("RCH").Range("G1") = Target
        Exit For
Else
'Fermé donc on ouvre le fichier
    MsgBox "test2"
        Set Brass = Workbooks.Open("http://monserveur.mondomaine/test.xlsm")
        'on copie la cellule en cours dans l'onglet RCH cellule G1
        Brass.Sheets("RCH").Range("G1") = Target
Exit For
End If
Next
Cancel = True
'Cas Else = elements inactif dc sert rien alors on sort de la macro.
Case Else
Cancel = False
Exit Sub
End Select
End Sub

je pense que la boucle du for se déroule mal mais je vois pas ou. Merci

 

[Roland_M]

Re : Vérifier si classeur déjà ouvert (fichier distant HTTP)

re

'sans trop chercher dans le code ce que tu veux faire,
 'ici ça ne va pas ! car à la première lecture tu considères qu'il n'est pas présent!?
 'il faut d'abord terminer la boucle !
 'voir pour modifier cette partie du code ...
 Dim Brass As Workbook, I%, TestPresent%
 TestPresent = 0
 For I = 1 To Workbooks.Count
  If Workbooks(I).Name = "test.xlsm" Then
     MsgBox "présent"
     Set Brass = Workbooks(I)
     Brass.Activate
     Brass.Sheets("RCH").Range("G1") = Target
     TestPresent = 1: Exit For
  End If
 Next
 If TestPresent = 0 Then 'non présent donc on ouvre le fichier
    MsgBox "loader"
    Set Brass = Workbooks.Open("http://monserveur.mondomaine/test.xlsm")
    'on copie la cellule en cours dans l'onglet RCH cellule G1
    Brass.Sheets("RCH").Range("G1") = Target
 End If

EDIT: en plus simple...

 Dim Wb$, I%, TestPresent%
 Wb$ = "test.xlsm": TestPresent = 0
 For I = 1 To Workbooks.Count
  If Workbooks(I).Name = Wb$ Then TestPresent = 1: Exit For
 Next
 'on copie la cellule en cours dans l'onglet RCH cellule G1
 If TestPresent = 1 Then 'présent
    MsgBox Wb$ & " est présent !"
    Workbook(Wb$).Activate
  Else 'non présent, on load le fichier
    MsgBox Wb$ & " n'est présent... alors load ..."
    Workbooks.Open "http://monserveur.mondomaine/" & Wb$
  End If
 Sheets("RCH").Range("G1") = Target

 

[s8fx]

Re : Vérifier si classeur déjà ouvert (fichier distant HTTP)

Encore merci!
Effectivement je pensais rester dans la boucle de test et dérouler le code mais créer une variable pour finir le test,sortir et dérouler le code est bcp plus malin.
Merci encore pour l'aide et ces éclaircissements.
Bonne continuation!