检查Excel是否已打开(来自另一个Office 2010应用程序)

Question

这个问题从我在此问过的上一个问题继续.我正在使用建议的修复程序来检查Excel文件是否从Outlook宏(Office 2010)本地打开,但它没有按预期运行.这是我的代码可能会失败.

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

现在为FullFilePath(例如"C:\Data\Data.xlsx")给出的打开或关闭文件:

• Set xlApp = GetObject(FullFilePath).Application

两种方式都给我0错误.(即如果文件没有打开,它会打开文件.)

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

这两个案件都给了我-214722120.(自动化错误)

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

打开时给我0,不打开时给我429.啊哈？见下文.

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

这两个案件给了我432个.(在自动化操作期间找不到文件名或类名)

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

这两个案件给了我432个.

因此,唯一有效的案例是最初建议的修复(参见顶部的链接),除非在本地打开的Excel的第一个实例中找不到该文件,但可能并非总是如此(即它可能在一秒钟内打开)实例.)

我做错了什么,或者我不应该使用这种方法来检查？最后,我想检查文件是否在网络上打开,如果是,那么检查它是否在本地打开.

Answer 1

如果您打开了多个Excel实例,那么这就是我的建议.

逻辑

1. 检查您的工作簿是否已打开.如果没有打开,则打开它.
2. 如果它是打开的,那么它可以在任何Excel实例中.
3. 找到Excel实例并与相关工作簿绑定.

GetObject遗憾的是,除非您关闭该Excel实例,否则每次都会返回相同的实例.此外,没有可靠的方法让它循环遍历所有Excel实例.谈到可靠性,我会把注意力转向API.我们将使用的3个API是FindWindowEx,GetDesktopWindow和AccessibleObjectFromWindow&

请参阅此示例(2010年EXCEL中的试用和测试)

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