检查Excel是否打开（从另一个Office 2010应用程序）

这个问题从我在这里问的一个先前的问题继续。 我正在使用build议的修复程序来检查一个Excel文件是否从Outlookmacros（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给出的打开或closures的文件（例如"C:\Data\Data.xlsx" ）：

• Set xlApp = GetObject(FullFilePath).Application

任何一种方式都会给我带来错误 （即它打开文件，如果它没有打开。）

• 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。

因此，唯一可行的是最初build议的修复方法（请参阅顶部的链接），除非它是在本地打开的第一个Excel实例中才能find该文件，但并非总是如此（即可能在一秒实例。）

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

Answer 1

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

逻辑

1. 检查您的工作簿是否打开。 如果没有打开，那就打开它。
2. 如果它是开放的，那么它可以在任何Excel实例。
3. findExcel实例并绑定到相关的工作簿。

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

看到这个例子（ 在EXCEL 2010中进行了TRIED AND TESTED ）

 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文件是否打开，您可以使用此function。

 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