检查Excel工作簿是否打开(通过另一个Office 2010应用程序) [英] Check to see if Excel workbook is open (from another Office 2010 App)
问题描述
此问题是我在此处询问的上一个问题的延续.我正在使用建议的修复程序来检查是否已从Outlook宏(Office 2010)在本地打开Excel文件，但未按预期工作.这是我的代码，可能会失败.
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
现在可用于由 FullFilePath 给出的打开或关闭文件(例如"C:\ Data \ Data.xlsx" ):
Now for open or closed files given by FullFilePath (e.g. "C:\Data\Data.xlsx"):
-
设置xlApp = GetObject(FullFilePath).Application
无论哪种方式都会给我0错误.(即，如果文件未打开，则会打开文件.)
gives me 0 error either way. (i.e. it opens the file if it's not open.)
-
设置xlApp = GetObject(Dir(FullFilePath)).Application
在两种情况下均给我-214722120.(自动化错误)
gives me -214722120 for both cases. (Automation error)
-
设置xlApp = GetObject(，" Excel.Application")
打开时给我0，不打开时给我429.啊?！见下文.
gives me 0 when open and 429 when not open. Aha?! See below.
-
设置xlApp = GetObject(Dir(FullFilePath)，" Excel.Application")
在两种情况下均给我432.(在自动化操作期间找不到文件名或类名)
gives me 432 for both cases. (File name or class name not found during Automation operation)
-
设置xlApp = GetObject(FullFilePath，" Excel.Application")
这两种情况都给我432.
gives me 432 for both cases.
因此，唯一可行的情况是最初建议的修复(请参见顶部的链接)，除非在本地打开的Excel的第一个实例中，否则找不到文件(可能并非总是如此)在第二种情况下.)
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.
推荐答案
如果您打开了多个Excel实例，那么这就是我的建议.
If you have multiple Excel instances open then this is what I suggest.
逻辑
- 检查工作簿是否打开.如果未打开，则将其打开.
- 如果打开，则它可以在任何Excel实例中.
- 找到Excel实例并与相关工作簿绑定.
不幸的是，除非您关闭该Excel实例，否则
GetObject 每次都会返回相同的实例.此外，没有可靠的方法来使其遍历所有Excel实例.谈到可靠性，我将把您的注意力转向API.我们将使用的3个API是 FindWindowEx ， GetDesktopWindow 和 AccessibleObjectFromWindow&
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&
请参见以下示例(在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屋！
