vba 检查 Excel 是否已打开（来自另一个 Office 2010 应用程序）

Question

提问by Chris Day

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.

这个问题是我在此处提出的先前问题的延续。我正在使用建议的修复程序来检查 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

Now for open or closed files given by FullFilePath(e.g. "C:\Data\Data.xlsx"):

现在对于由FullFilePath（例如"C:\Data\Data.xlsx"）给出的打开或关闭的文件：

Set xlApp = GetObject(FullFilePath).Application

Set xlApp = GetObject(FullFilePath).Application

gives me 0 error either way. (i.e. it opens the file if it's not open.)

无论哪种方式都给我 0 错误。（即，如果文件未打开，它将打开文件。）

Set xlApp = GetObject(Dir(FullFilePath)).Application

Set xlApp = GetObject(Dir(FullFilePath)).Application

gives me -214722120 for both cases. (Automation error)

两种情况都给我 -214722120。（自动化错误）

Set xlApp = GetObject(, "Excel.Application")

Set xlApp = GetObject(, "Excel.Application")

gives me 0 when open and 429 when not open. Aha?! See below.

打开时给我 0，不打开时给我 429。啊哈？！见下文。

Set xlApp = GetObject(Dir(FullFilePath), "Excel.Application")

Set xlApp = GetObject(Dir(FullFilePath), "Excel.Application")

gives me 432 for both cases. (File name or class name not found during Automation operation)

两种情况都给我 432。（自动化操作期间未找到文件名或类名）

Set xlApp = GetObject(FullFilePath, "Excel.Application")

Set xlApp = GetObject(FullFilePath, "Excel.Application")

gives me 432 for both cases.

两种情况都给我 432。

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.)

因此，唯一有效的情况是最初建议的修复程序（请参阅顶部的链接），除非它在本地打开的第一个 Excel 实例中，否则无法找到该文件，但情况并非总是如此（即它可能会在第二个实例中打开）实例。）

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.

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

Answer 1

回答by Siddharth Rout

If you have multiple Excel instances open then this is what I suggest.

如果您打开了多个 Excel 实例，那么这就是我的建议。

Logic

逻辑

Check if your workbook is open or not. If not open, then open it.
If it is open then it could be in any Excel instance.
Find the Excel instance and bind with the relevant workbook.

检查您的工作簿是否打开。如果没有打开，那就打开它。
如果它是打开的，那么它可以在任何 Excel 实例中。
找到 Excel 实例并与相关工作簿绑定。

GetObjectunfortunately 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, GetDesktopWindowand AccessibleObjectFromWindow&

GetObject不幸的是，除非您关闭该 Excel 实例，否则每次都会返回相同的实例。也没有可靠的方法让它循环遍历所有 Excel 实例。谈到可靠性，我会将您的注意力转向 API。我们将使用的 3 个 API 是FindWindowEx，GetDesktopWindow以及AccessibleObjectFromWindow&

See this example (TRIED AND TESTED in EXCEL 2010)

请参阅此示例（在 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

Answer 2

回答by Siddharth Rout

To see if an Excel file is open or not, you can use this 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

Answer 3

回答by Hyman Gajanan

you can check if file is open or not and get object if it is open

您可以检查文件是否打开，如果打开则获取对象

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

or

或者

Public Shared Function getOrOpenBook(ByVal xlFileName As String) As Excel.Workbook
    Return System.Runtime.InteropServices.Marshal.BindToMoniker(xlFileName)
End Function

vba 检查 Excel 是否已打开（来自另一个 Office 2010 应用程序）

提问by Chris Day

回答by Siddharth Rout

回答by Siddharth Rout

回答by Hyman Gajanan

相关推荐

最近更新

标签

vba 检查 Excel 是否已打开（来自另一个 Office 2010 应用程序）

提问by Chris Day

回答by Siddharth Rout

回答by Siddharth Rout

回答by Hyman Gajanan

相关推荐

从 VBA 中的字符串中提取子字符串

vba 访问查询需要绕过“输入参数值”错误，消息框提示未找到字段

vba 可移动表单上的 MS Access/在其自己的窗口中拥有一个表单，不受应用程序的限制

VBA - 有效地访问和查找 CSV 文件中的值

相关推荐

最近更新

标签