Bonjour,

Comment contrôler si un fichier donné excel est ouvert. Je voudrais faire un test pour voir si le fichier en question est ouvert afin de ne pas faire le code s'il est ouvert.

Merci d'avance et bonne prog
@+++
marcod59

Salut,

utilise mon snippet, il est fait pour :


Private Const OF_SHARE_EXCLUSIVE = &H10
Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Function OpenDocXlsFile(FileToOpen As String) As Long
'   retourne  :
'   -1  -> erreur
'   0   -> fichier déjà ouvert, ouverture en lecture  seule
'   1   -> ouverture première  instance
    OpenDocXlsFile = -1
    
    Dim sExt        As String
    Dim NomAppli    As String
'   type de fichier  par son extension
    If LenB(FileToOpen) < 16 Then
        Exit Function
    Else
        sExt = LCase$(RightB$(FileToOpen, 8))
        If sExt = ".doc" Or sExt = ".rtf" Then
            NomAppli = "Word"
        ElseIf sExt = ".xls" Or sExt = ".csv" Then
            NomAppli = "Excel"
        Else
            Exit Function
        End If
    End If
'   ouverture  office
    Dim MonApp      As Object
    Dim MonDoc      As Object
    Dim hFile       As Long
    
    hFile = lopen(FileToOpen, OF_SHARE_EXCLUSIVE)
    If hFile <> -1 Then 'pas ouvert
        lclose (hFile)
        Set MonApp = CreateObject(NomAppli & ".Application")
        If NomAppli = "Word" Then
            Set MonDoc = MonApp.Documents.Open(FileToOpen)
        Else
            Set MonDoc = MonApp.Workbooks.Open(FileToOpen)
        End If
        OpenDocXlsFile = 1
    ElseIf (hFile = -1) And (Err.LastDllError = 32) Then 'déjà ouvert
        lclose (hFile)
        Set MonApp = CreateObject(NomAppli & ".Application")
        If NomAppli = "Word" Then
            On Local Error Resume Next
            Set MonDoc = MonApp.Documents.Open(FileToOpen, , True)
            If Err.Number = 4198 Then
'               word 2000, utilisateur fait  ANNULER
                Err.Clear
                GoTo Lbl_Exit
            End If
            On Error GoTo 0
        Else
            Set MonDoc = MonApp.Workbooks.Open(FileToOpen, , True)
        End If
        OpenDocXlsFile = 0
    End If
    MonApp.Visible = True
    
Lbl_Exit:
    Set MonDoc = Nothing
    Set MonApp = Nothing
End Function

'    EXEMPLE
Private Sub Form_Load()
    Debug.Print "Word : " & OpenDocXlsFile("C:\Nouveau  Document Microsoft Word.doc")
    Debug.Print "Excel : " & OpenDocXlsFile("C:\test.xls")
    
    Unload Me
End Sub

~ Mortalino ~ Colorisation automatique

@++

---

Tu travailles à partir d'Excel (VBA) ou de VB ou autre ?

Si tu travailles sous Excel, il y a la "collection" Windows qui te donne le nom de tous les fichiers qui sont ouverts dans la session. Équivalent à aller dans le menu Fenêtre et regarder ce qui s'y trouve.

MPi

Salut Mortalino et MPI,

Premièrement, merci d'avoir répondu, ensuite.
Pour répondre à MPI, je travail en VB.
Pour Mortalino, j'ai un petit souci avec ton code. Tout d'abord, je l'ai mis dans un module, ensuite je l'ai inclus dans mon code de cette façon :

Private Sub Cmdexcel_Click()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim XlSheet As Excel.Worksheet
    Dim b, l As Integer

    Set xlApp = New Excel.Application
    Set xlBook = xlApp.Workbooks.Add
    Set XlSheet = xlBook.Worksheets(1)
    '' désactive les messages d'Excel
    xlApp.Application.DisplayAlerts = False

If OpenDocXlsFile(App.Path & "\relevé.xls") = 0 Then
    msg = MsgBox("Veuillez fermer le fichier relevé.xls" & Chr(10) & "pour pouvoir récupérer les données", vbCritical)
    GoTo fin
End If
' Ouvre le fichier
    xlApp.Workbooks.Open FileName:=App.Path & "\relevé.xls", Editable:=True, ReadOnly:=False
b = Lstview1.ListItems.Count
For a = 1 To b
            l = xlApp.Sheets("donnees").Range("A65536").End(xlUp).row + 1
        Set ObjListe = Nothing
        Set ObjListe = Lstview1.ListItems(a)
            xlApp.Sheets("donnees").Range("A" & l).Value = Lstview1.ListItems.Item(1)
            xlApp.Sheets("donnees").Range("B" & l).Value = ObjListe.SubItems(1)
            xlApp.Sheets("donnees").Range("C" & l).Value = ObjListe.SubItems(2)
            xlApp.Sheets("donnees").Range("D" & l).Value = ObjListe.SubItems(3)
            xlApp.Sheets("donnees").Range("E" & l).Value = ObjListe.SubItems(4)
            xlApp.Sheets("donnees").Range("F" & l).Value = ObjListe.SubItems(5)
            xlApp.Sheets("donnees").Range("G" & l).Value = ObjListe.SubItems(6)
            xlApp.Sheets("donnees").Range("H" & l).Value = ObjListe.SubItems(7)
            xlApp.Sheets("donnees").Range("I" & l).Value = ObjListe.SubItems(8)
            xlApp.Sheets("donnees").Range("J" & l).Value = ObjListe.SubItems(9)
            xlApp.Sheets("donnees").Range("K" & l).Value = ObjListe.SubItems(10)
            xlApp.Sheets("donnees").Range("L" & l).Value = ObjListe.SubItems(11)
            xlApp.Sheets("donnees").Range("M" & l).Value = ObjListe.SubItems(12)
Next a
fin:
    xlApp.ActiveWorkbook.Save
    xlApp.Application.DisplayAlerts = True
    xlBook.Close
    xlApp.Quit
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set XlSheet = Nothing
End Sub

Le problème, et qu'il m'ouvre à chaque fois un fichier excel et que dans tous les cas, je n'arrive pas à enregistrer les données.
Je pense que je n'utilise pas ton code correctement. Peux-tu me mettre sur le bon rail. Merci

Joyeuses Pâques à vous
@+++
marcod59

Merci MPI, c'est justement ce que je cherchais. Juste le nom du fichier afin de faire le test car s'il est ouvert je ne peux rentrer les données. Donc en faisant un test avant, je le signale pour qu'il soit fermé.

Joyeuses Pâques
@+++
marcod59

Attention toutefois ...
Le fichier pourrait être ouvert dans une autre session d'Excel.
À ce moment-là, il ne serait pas dans la liste, je pense (?)
Tu pourrais toujours ajouter une gestion d'erreur.


MPi