Check if Excel is open (from another Office 2010 application)

Question

This question continues on the previous question that I asked here . I use the proposed fix to check if an Excel file is open locally from an Outlook macro (Office 2010), but it does not work as expected. Here is my code that may not work.

Public Sub UpdateFileIndex(ByVal FullFilePath As String, ByVal DocNo As String)
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.WorkSheet

    On Error Resume Next
    Set xlApp = GetObject(FullFilePath).Application
    Debug.Print "Error = " & Err

    If Err.Number = 0 Then ' Workbook is open locally
        ' Do stuff
    ElseIf Err.Number = 429 Then ' Workbook is not open locally
        ' Do different stuff
    End If

    ' Do a bunch of other stuff
End Sub

Now for open or closed files specified FullFilePath(e.g. "C:\Data\Data.xlsx"):

• Set xlApp = GetObject(FullFilePath).Application

gives me 0 errors anyway. (i.e., it opens the file if it does not open.)

• Set xlApp = GetObject(Dir(FullFilePath)).Application

gives me -214722120 for both cases. (Automation Error)

• Set xlApp = GetObject(, "Excel.Application")

gives 0 when opened and 429 when they are not open. Yeah ?! See below.

• Set xlApp = GetObject(Dir(FullFilePath), "Excel.Application")

gives me 432 for both cases. (File name or class name not found during automation operation)

• Set xlApp = GetObject(FullFilePath, "Excel.Application")

gives me 432 for both cases.

, , , - (. ), , Excel , (.. .)

- , ? , , , , .

Answer 1

Excel, , .

• , . , .
• , Excel.
• Excel .

GetObject , Excel. Excel. , API. 3 API, , FindWindowEx, GetDesktopWindow AccessibleObjectFromWindow&

. (TRIED AND TESTED EXCEL 2010)

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _
(ByVal hwnd&, ByVal dwId&, riid As GUID, xlWB As Object)

Private Const OBJID_NATIVEOM = &HFFFFFFF0

Private Type GUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    aBData4(0 To 7) As Byte
End Type

Sub Sample()
    Dim Ret
    Dim oXLApp As Object, wb As Object
    Dim sPath As String, sFileName As String, SFile As String, filewithoutExt As String
    Dim IDispatch As GUID

    sPath = "C:\Users\Chris\Desktop\"
    sFileName = "Data.xlsx": filewithoutExt = "Data"
    SFile = sPath & sFileName

    Ret = IsWorkBookOpen(SFile)

    '~~> If file is open
    If Ret = True Then
        Dim dsktpHwnd As Long, hwnd As Long, mWnd As Long, cWnd As Long

        SetIDispatch IDispatch

        dsktpHwnd = GetDesktopWindow

        hwnd = FindWindowEx(dsktpHwnd, 0&, "XLMAIN", vbNullString)

        mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)

        While mWnd <> 0 And cWnd = 0
            cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt)
            hwnd = FindWindowEx(dsktpHwnd, hwnd, "XLMAIN", vbNullString)
            mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
        Wend

        '~~> We got the handle of the Excel instance which has the file
        If cWnd > 0 Then
            '~~> Bind with the Instance
            Call AccessibleObjectFromWindow(cWnd, OBJID_NATIVEOM, IDispatch, wb)
            '~~> Work with the file
            With wb.Application.Workbooks(sFileName)
                '
                '~~> Rest of the code
                '
            End With
        End If

    '~~> If file is not open
    Else
        On Error Resume Next
        Set oXLApp = GetObject(, "Excel.Application")

        '~~> If not found then create new instance
        If Err.Number <> 0 Then
            Set oXLApp = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo 0

        Set wb = oXLApp.Workbooks.Open(SFile)
        '
        '~~> Rest of the code
        '
    End If
End Sub

Private Sub SetIDispatch(ByRef ID As GUID)
    With ID
        .lData1 = &H20400
        .iData2 = &H0
        .iData3 = &H0
        .aBData4(0) = &HC0
        .aBData4(1) = &H0
        .aBData4(2) = &H0
        .aBData4(3) = &H0
        .aBData4(4) = &H0
        .aBData4(5) = &H0
        .aBData4(6) = &H0
        .aBData4(7) = &H46
    End With
End Sub

'~~> Function to check if file is open
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

Answer 2

, Excel , .

Sub Sample()
    Dim Ret
    Dim sFile As String

    sFile = "C:\Users\Chris\Desktop\Data.xlsx"
    Ret = IsWorkBookOpen(sFile)

    If Ret = True Then
        MsgBox "File is Open"
    Else
        MsgBox "File is not Open"
    End If
End Sub

'~~> Function to check if file is open
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

Answer 3

, , , .

Public Shared Function isFileAlreadyOpen(ByVal xlFileName As String) As Boolean
    Return CBool(Not getIfBookOpened(xlFileName) Is Nothing)
End Function

Public Shared Function getIfBookOpened(ByVal xlFileName As String) As Excel.Workbook
    Dim wbBook As Excel.Workbook
    Dim xlProcs() As Process = Process.GetProcessesByName("EXCEL")
    If xlProcs.Count > 0 Then
        Dim xlApp As Excel.Application = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application"), Excel.Application)
        For Each wbBook In xlApp.Workbooks
            If wbBook.FullName.ToUpper = xlFileName.ToUpper Then
                Return wbBook
                Exit For
            End If
        Next
    End If
    Return Nothing
End Function

Public Shared Function getOrOpenBook(ByVal xlFileName As String) As Excel.Workbook
    Return System.Runtime.InteropServices.Marshal.BindToMoniker(xlFileName)
End Function