检查 Excel 工作簿是否从另一个 Office 2010 应用程序打开 [英] Check if Excel workbook is open from another Office 2010 App
问题描述
这是上一个问题的延续.我尝试了建议的修复程序来检查 Excel 文件是否从 Outlook 宏 (Office 2010) 本地打开.
This continues from a previous question. I tried the suggested fix to check if an Excel file is open locally from an Outlook macro (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:DataData.xlsx"
):
Now for open or closed files given by FullFilePath
(e.g. "C:DataData.xlsx"
):
Set xlApp = GetObject(FullFilePath).Application
无论哪种方式都给我 0 个错误.(即,如果文件未打开,它将打开该文件.)
gives me 0 error either way. (i.e. it opens the file if it's not open.)
Set xlApp = GetObject(Dir(FullFilePath)).Application
这两种情况都给我 -214722120.(自动化错误)
gives me -214722120 for both cases. (Automation error)
Set xlApp = GetObject(, "Excel.Application")
打开时给我 0,不打开时给我 429.见下文.
gives me 0 when open and 429 when not open. See below.
Set xlApp = GetObject(Dir(FullFilePath), "Excel.Application")
这两种情况都给我 432.(自动化操作期间未找到文件名或类名)
gives me 432 for both cases. (File name or class name not found during Automation operation)
Set 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).
最终我想检查文件是否在网络上打开,以及是否检查它是否在本地打开.
Ultimately I'd like to check if the file is open on the network, and if it is check if it's open locally.
推荐答案
如果您打开了多个 Excel 实例,那么这就是我的建议.
If you have multiple Excel instances open then this is what I suggest.
逻辑
- 检查您的工作簿是否打开.如果没有打开,那就打开它.
- 如果它是打开的,那么它可以在任何 Excel 实例中.
- 找到 Excel 实例并与相关工作簿绑定.
GetObject
不幸的是每次都会返回相同的实例,除非您关闭该 Excel 实例.也没有可靠的方法让它循环遍历所有 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:UsersChrisDesktop"
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屋!