[英]Check if Excel workbook 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
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 实例,那么这就是我的建议。
逻辑
遗憾的是,除非您关闭该 Excel 实例,否则GetObject
每次都会返回相同的实例。 也没有可靠的方法让它遍历所有 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
要查看 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
以下只需要工作簿文件名,不需要完整路径:
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
对象……)
如果您想通过完全限定路径检查文件,请使用此答案中的函数。
您可以检查文件是否打开,如果打开则获取对象
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.