Détecter si le classeur Excel est déjà ouvert

Essayez ceci:

Option Explicit

Sub Sample()
    Dim Ret

    Ret = IsWorkBookOpen("C:\myWork.xlsx")

    If Ret = True Then
        MsgBox "File is open"
    Else
        MsgBox "File is Closed"
    End If
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Si son ouverture, il sera dans la collection de Classeurs:

Function BookOpen(strBookName As String) As Boolean
    Dim oBk As Workbook
    On Error Resume Next
    Set oBk = Workbooks(strBookName)
    On Error GoTo 0
    If oBk Is Nothing Then
        BookOpen = False
    Else
        BookOpen = True
    End If
End Function

Sub testbook()
    Dim strBookName As String
    strBookName = "myWork.xls"
    If BookOpen(strBookName) Then
        MsgBox strBookName & " is open", vbOKOnly + vbInformation
    Else
        MsgBox strBookName & " is NOT open", vbOKOnly + vbExclamation
    End If
End Sub

Que si vous voulez vérifier sans créer une autre instance d'Excel?

Par exemple, j'ai une macro Word (ce qui est exécutée à plusieurs reprises) qui a besoin d'extraire des données à partir d'une feuille de calcul Excel. Si la feuille de calcul est déjà ouvert dans une instance d'Excel, je préfère ne pas créer une nouvelle instance.

J'ai trouvé une excellente réponse ici ce que j'ai construit sur:
http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Grâce à MikeTheBike et kirankarnati

Function WorkbookOpen(strWorkBookName As String) As Boolean
    'Returns TRUE if the workbook is open
    Dim oXL As Excel.Application
    Dim oBk As Workbook

    On Error Resume Next
    Set oXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        'Excel is NOT open, so the workbook cannot be open
        Err.Clear
        WorkbookOpen = False
    Else
        'Excel is open, check if workbook is open
        Set oBk = oXL.Workbooks(strWorkBookName)
        If oBk Is Nothing Then
            WorkbookOpen = False
        Else
            WorkbookOpen = True
            Set oBk = Nothing
        End If
    End If
    Set oXL = Nothing
End Function

Sub testWorkbookOpen()
    Dim strBookName As String
    strBookName = "myWork.xls"
    If WorkbookOpen(strBookName) Then
        msgbox strBookName & " is open", vbOKOnly + vbInformation
    Else
        msgbox strBookName & " is NOT open", vbOKOnly + vbExclamation
    End If
End Sub

Checkout cette fonction

'********************************************************************************************************************************************************************************
'Function Name                     : IsWorkBookOpen(ByVal OWB As String)
'Function Description             : Function to check whether specified workbook is open
'Data Parameters                  : OWB:- Specify name or path to the workbook. eg: "Book1.xlsx" or "C:\Users\Kannan.S\Desktop\Book1.xlsm"

'********************************************************************************************************************************************************************************
Function IsWorkBookOpen(ByVal OWB As String) As Boolean
    IsWorkBookOpen = False
    Dim WB As Excel.Workbook
    Dim WBName As String
    Dim WBPath As String
    Err.Clear
    On Error Resume Next
    OWBArray = Split(OWB, Application.PathSeparator)
    Set WB = Application.Workbooks(OWBArray(UBound(OWBArray)))
    WBName = OWBArray(UBound(OWBArray))
    WBPath = WB.Path & Application.PathSeparator & WBName
    If Not WB Is Nothing Then
        If UBound(OWBArray) > 0 Then
            If LCase(WBPath) = LCase(OWB) Then IsWorkBookOpen = True
        Else
            IsWorkBookOpen = True
        End If
    End If
    Err.Clear
End Function