检查Excel是否打开（从另一个Office 2010应用程序） [英] Check to see if Excel is open (from another Office 2010 App)

问题描述

这个问题从上一个问题继续，我问这里。我正在使用建议的修复程序来检查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 
 
如果Err.Number = 0然后工作簿在本地打开
'做东西
 ElseIf Err.Number = 429然后工作簿不在本地打开
'做不同的东西
结束如果
 
'做一堆其他的东西
结束Sub 
  

现在由 FullFilePath （例如C：\Data\Data.xlsx给出的打开或关闭的文件）：

• 设置xlApp = GetObject（FullFilePath）.Application

无论如何，给我0个错误。 （即，如果文件未打开，则打开文件。）

• 设置xlApp = GetObject（Dir（FullFilePath）） 。应用

给了我-214722120两种情况。 （自动化错误）

• 设置xlApp = GetObject（，Excel.Application）

打开时给我0，打开时打开429。啊哈？设置xlApp = GetObject（Dir（FullFilePath），Excel.Application）

给出了432这两种情况。 （在自动化操作期间找不到文件名或类名）

• 设置xlApp = GetObject（FullFilePath，Excel。应用程序）

给我432个两种情况。

所以唯一可行的情况是最初建议的修复（请参阅顶部的链接），除非是在本地开放的Excel的第一个实例中找不到该文件，否则可能并非如此在第二个例子中打开。）

我做错了什么，还是我不应该使用这种方法来检查？最终我想检查该文件是否在网络上打开，如果它是检查是否在本地打开。

解决方案

如果您有多个Excel实例打开，那么这是我建议的。

逻辑

1. 检查您的工作簿是否开放。如果没有打开，那么打开它。


2. 如果它是打开的，那么它可以在任何Excel实例中。


3. 查找Excel实例并绑定相关工作簿

GetObject 不幸的是每次都会返回相同的实例，除非关闭该Excel实例。也没有可靠的方式让它循环遍历所有的Excel实例。谈到可靠性，我会把注意力转向API。我们将使用的3个API是 FindWindowEx ， GetDesktopWindow 和 AccessibleObjectFromWindow&

看到这个例子（EXCEL 2010中 TRIED AND TESTED ）

  Option Explicit 
 
私有声明函数FindWindowEx Libuser32别名FindWindowExA_ 
（ByVal hWnd1 As Long，ByVal hWnd2 As Long，ByVal lpsz1 As String，_ 
 ByVal lpsz2 As String）As Long 
 
私有声明函数GetDesktopWindow Libuser32（）As Long 
 
私有声明函数AccessibleObjectFromWindow& Liboleacc_ 
（ByVal hwnd& ByVal dwId& riid As GUID，xlWB As Object）
 
 Private Const OBJID_NATIVEOM =& HFFFFFFF0 
 
私人键入GUID 
 lData1 As Long 
 iData2 As Integer 
 iData3 As Integer 
 aBData4（0到7）As Byte 
结束类型
 
 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）
 
'~~>如果文件打开
如果Ret = True然后
 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） 
 
当mWnd<> 0和cWnd = 0 
 cWnd = FindWindowEx（mWnd，0&EXCEL7，filewithoutExt）
 hwnd = FindWindowEx（dsktpHwnd，hwnd，XLMAIN，vbNullString）
 mWnd = FindWindowEx hwnd，0&XLDESK，vbNullString）
 Wend 
 
'~~>我们得到了具有文件
的Excel实例的句柄如果cWnd> 0然后
'~~>与实例绑定
调用AccessibleObjectFromWindow（cWnd，OBJID_NATIVEOM，IDispatch，wb）
'~~>使用文件
使用wb.Application.Workbooks（sFileName）
'
'~~>其余的代码
'
结束
结束如果
 
'~~>如果文件未打开
 Else 
 On Error Resume Next 
设置oXLApp = GetObject（，Excel.Application）
 
'~~>如果没有找到，则创建新的实例
如果Err.Number<> 0然后
设置oXLApp = CreateObject（Excel.Application）
结束如果
 Err.Clear 
错误GoTo 0 
 
设置wb = oXLApp .Workbooks.Open（SFile）
'
'~~>其余的代码
'
结束如果
结束Sub 
 
私有Sub SetIDispatch（ByRef ID作为GUID）
带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 Sub 
 
'〜 〜>函数检查文件是否打开
函数IsWorkBookOpen（FileName As String）
 Dim ff As Long，ErrNo As Long 
 
 On Error Resume Next 
 ff = FreeFile ）
打开FileName输入锁读取为#ff 
关闭ff 
 ErrNo = Err 
出错GoTo 0 
 
选择案例ErrNo 
案例0：IsWorkBookOpen = False 
案例70：IsWorkBookOpen = True 
案例：错误ErrNo 
结束选择
结束函数
  pre> 
This question continues from a previous question I asked here. I'm using the suggested fix to check if an Excel file is open locally from an Outlook macro (Office 2010), but it's not working out as expected. Here's my code that's possibly failing. 
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 given by FullFilePath (e.g. "C:\Data\Data.xlsx"):


Set xlApp = GetObject(FullFilePath).Application


gives me 0 error either way. (i.e. it opens the file if it's not open.)


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


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


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


gives me 0 when open and 429 when not open. Aha?! 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.

So the only case that works is the initially suggested fix (see link at top), which cannot find the file unless it's in the first instance of Excel open locally, which may not always be the case (i.e. it may be open in a second instance.)

Am I doing something wrong, or should I not be using this method to check? Ultimately I'd like to check if the file is open on the network, and if it is then check if it's open locally. 
解决方案
If you have multiple Excel instances open then this is what I suggest.

Logic

Check if your workbook is open or not. If not open, then open it.
If it is open then it could be in any Excel instance.
Find the Excel instance and bind with the relevant workbook.
GetObject unfortunately will return the same instance every time unless you close that Excel instance. Also there is no reliable way to get it to loop through all Excel instances. Talking of reliability, I would turn your attention towards APIs. The 3 APIs that we will use is FindWindowEx , GetDesktopWindow and AccessibleObjectFromWindow&

See this example (TRIED AND TESTED in 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


                        
这篇关于检查Excel是否打开（从另一个Office 2010应用程序）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！