在excel文件中设置单元格的值在打开多个excel文件时出错

我想在outlook中写一个macros来检查是否excel文件打开，如果这个文件没有打开，打开它并为单元格（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 

但是我的问题是当这个文件打开，其他一些文件也打开。 它不能为单元格设置值，并得到错误“下标超出范围”。 当我debugging时，错误定位在“Set WB = objExcel.Workbooks（”Book2.xlsm“）”。 你能告诉我它有什么问题，我该如何解决。 只要有我的单一的Excel文件，一切运行良好，并有less数文件打开时得到问题

Answer 1

如果有多个Excel.Application实例在运行，则会遇到问题，否则这将会起作用。

 Sub TestWrite() Const FULLNAME As String = "C:\Users\sang\Desktop\Book2.xlsm" Dim objExcel As Object, WB As Object, WS As Object Set objExcel = getExcelAppication objExcel.Visible = True Set WB = getWorkbook(objExcel, FULLNAME) If WB Is Nothing Then MsgBox "File not found: " & FULLNAME, vbInformation, ":(" Else Set WS = WB.Worksheets("Sheet1") WS.Range("A1").Value = "haha" End If End Sub Function getExcelAppication() As Object Dim objExcel As Object If GetObject("winmgmts:").ExecQuery("select * from win32_process where name='Excel.exe'").Count > 0 Then Set objExcel = GetObject(, "Excel.Application") Else Set objExcel = CreateObject("Excel.Application") End If Set getExcelAppication = objExcel End Function Function getWorkbook(objExcel As Object, FULLNAME As String) As Object Dim ShortName As String Dim WB As Object, WS As Object ShortName = Right(FULLNAME, Len(FULLNAME) - InStrRev(FULLNAME, "\")) For Each WB In objExcel.Workbooks If WB.Name = ShortName Then Set getWorkbook = WB Exit Function End If Next Set getWorkbook = objExcel.Workbooks.Open(FULLNAME) End Function 

Answer 2

如果有多个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 3

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

部分代码被修改为适合这篇文章，是从Ozgrid采取的

下面的代码是有点长，但除此之外，它的作品非常好（testing）

 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