下面的代码也适用于多个打开的 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