Question

我想在outlook中写一个宏来检查excel文件是否打开，如果没有打开这个文件，打开它并为cell（1,1）设置值。否则，如果它是打开的，只需设置单元格（1,1）的值，无需再次打开它。我这样做了，它运行正常。

这是我的源代码

Sub test_3()
    Dim objExcel As Object
    Dim WB As Object
    Dim WS As Object
    If (IsWorkBookOpen("C:\Users\sang\Desktop\Book2.xlsm") = True) Then 'check whether is file opening? if yes
        Set objExcel = GetObject(, "Excel.Application")
        objExcel.Visible = True
        Set WB = objExcel.Workbooks("Book2.xlsm")
        WB.Activate
    Else 'file is not opening
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = True
        Set WB = objExcel.Workbooks.Open("C:\Users\sang\Desktop\Book2.xlsm") 'open file
        WB.Activate
    End If
    Set WS = WB.Worksheets("Sheet1")
    WS.Range("A1").Value = "haha" 'set value for cell
End Sub

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

但我的问题是这个文件打开时还有一些其他文件正在打开。它不能为单元格设置值并获得错误“下标超出范围”。当我调试时，错误位于“设置WB = objExcel.Workbooks（”Book2.xlsm“）”。你能告诉我它有什么问题吗，我该怎么解决呢。只有我的单个excel文件时，一切都运行正常，并且当几个文件打开时出现问题

Answer 1

如果有多个Excel实例打开，则无法保证

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

将获取打开文件的实例。

尝试改为

Set objExcel = GetObject("C:\Users\sang\Desktop\Book2.xlsm", "Excel.Application")

或只是

Set objExcel = GetObject("C:\Users\sang\Desktop\Book2.xlsm")

Answer 2

如果有多个/** * */实例正在运行，您将遇到问题，但这样做会有效。

Excel.Application

Answer 3

以下代码也适用于多个打开的Excel实例。

为修改此帖子而修改的部分代码取自Ozgrid

下面的代码有点长，但除此之外它的工作非常好（经过测试）

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 IIDFromString Lib "ole32" _
(ByVal lpsz As Long, ByRef lpiid As GUID) As Long

Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const RETURN_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub ComplexTest()

    Dim hWndXL As Long
    Dim oXLApp As Object
    Dim oWB As Object         
    Dim objExcel As Object
    Dim WB As Object
    Dim WS As Object
    Dim FullFileName    As String
    Dim CleanFileName   As String

    FullFileName = "C:\Users\sang\Desktop\Book2.xlsm"
    CleanFileName = Right(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))

    ' check if the Excel's file name is already open
    If IsWorkBookOpen(FullFileName) Then                                        
         ' first Excel Window
        hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)             
         ' got one Excel instance open ?
        Do While hWndXL > 0

             ' Get a reference to current excel instance
            If GetReferenceToXLApp(hWndXL, oXLApp) Then                     
                 ' loop through workbooks
                For Each oWB In oXLApp.Workbooks
                    If oWB.Name = CleanFileName Then
                        Set WB = oWB
                    End If
                Next
            End If

             ' Find the next Excel Window
            hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
        Loop
    Else
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = True
        Set WB = objExcel.Workbooks.Open(FullFileName) 'open file
    End If

    Set WS = WB.Worksheets("Sheet1")
    WS.Range("A1").Value = "haha" 'set value for cell

End Sub

 ' This section of code was taken from Ozgrid
 ' link: http://www.ozgrid.com/forum/showthread.php?t=182853
 '
 ' The Function Returns a reference to a specific instance of Excel.
 ' The Instance is defined by the Handle (hWndXL) passed by the calling procedure

Function GetReferenceToXLApp(hWndXL As Long, oXLApp As Object) As Boolean

    Dim hWinDesk As Long
    Dim hWin7 As Long
    Dim obj As Object
    Dim iID As GUID

     ' Rather than explaining, go read
     ' http://msdn.microsoft.com/en-us/library/windows/desktop/ms687262(v=vs.85).aspx
    Call IIDFromString(StrPtr(IID_IDispatch), iID)

     ' We have the XL App (Class name XLMAIN)
     ' This window has a child called 'XLDESK' (which I presume to mean 'XL desktop')
     ' XLDesk is the container for all XL child windows....
    hWinDesk = FindWindowEx(hWndXL, 0&, "XLDESK", vbNullString)

     ' EXCEL7 is the class name for a Workbook window (and probably others, as well)
     ' This is used to check there is actually a workbook open in this instance.
    hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)

     ' Deep API... read up on it if interested.
     ' http://msdn.microsoft.com/en-us/library/windows/desktop/dd317978(v=vs.85).aspx
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iID, obj) = RETURN_OK Then
        Set oXLApp = obj.Application
        GetReferenceToXLApp = True
    End If

End Function

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文件时，设置excel文件中单元格的值会出错

3 个答案: