[英]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.