检查 Excel 工作簿是否从另一个 Office 2010 应用程序打开答案

【问题标题】：Check if Excel workbook is open from another Office 2010 App检查 Excel 工作簿是否从另一个 Office 2010 应用程序打开
【发布时间】：2012-06-28 07:35:51
【问题描述】：

这从之前的question 继续。我尝试了建议的修复程序来检查是否从 Outlook 宏 (Office 2010) 在本地打开 Excel 文件。

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 实例中，否则无法找到文件，这可能并非总是如此（即它可能是打开的）在第二种情况下）。

最后我想检查一下文件是否在网络上打开，如果是，检查它是否在本地打开。

【问题讨论】：

标签： excel file vba outlook

【解决方案1】：

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

逻辑

检查您的工作簿是否打开。如果未打开，则打开它。
如果它是打开的，那么它可以在任何 Excel 实例中。
找到 Excel 实例并与相关工作簿绑定。

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

查看此示例（在 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

【讨论】：

好的，太棒了。我会试试看。非常感谢您对悉达多的帮助。
一旦我将 cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt) 更改为使用 sFileName 作为最后一个参数，它就可以完美运行。再次感谢。
最后一件事......在Call AccessibleObjectFromWindow(cWnd, OBJID_NATIVEOM, IDispatch, wb) 之后，我将根据DocNo 的值链接到工作表对象（使用Set xlSheet = ...）。我不确定如何从 With 构造中执行此操作。有没有办法做到这一点，或者直接链接到工作簿对象（比如Set xlBook = xlApp.Workbooks("File Index.xlsx") 或其他东西。谢谢！我在这里学到了很多东西。:)
您已经使用With wb.Application.Workbooks(sFileName) 连接到工作簿现在您可以连接到您想要的任何工作表:)
好的，我只是不确定确切的命令或语法，但我会尝试一下，看看我想出了什么。谢谢。

【解决方案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

【讨论】：

酷，谢谢。这工作得很好。仍然存在查找当前用户是否打开它或者它是否被另一个用户打开的问题。我刚刚发现了这个，但我还没有测试它：Checking if a Workbook is Open in any Excel Instance
我实际上在你的其他帖子中回答了但删除了它:) 我会在这里收到那个帖子:)
将其作为单独的答案发布。 :)

【解决方案3】：

以下只需要工作簿文件名，不需要完整路径：

Sub IsOpen()
 With CreateObject("Word.Application")
    If .Tasks.exists("Workbook.xlsb") Then MsgBox "The Workbook is open"
    .Quit
 End With
End Sub

即使工作簿在不同的 Excel 实例中打开，这也会成功。

（是的，即使您对 Excel 感兴趣，您也使用 Word.Application 对象......）

如果您想通过完全限定路径检查文件，请使用函数in this answer。

【讨论】：

【解决方案4】：

您可以检查文件是否打开，如果打开则获取对象

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

【讨论】：