p>我最终基本上放弃了GetObject，因为它不够细腻，并且写了我自己的flickerless开启者，有一些来自osknows的灵感和来自这里和 here 。以为我会分享它，以防其他人觉得有用。首先完整的模块

I ended up basically ditching GetObject, because it wasn't granular enough, and wrote my own flickerless opener, with some inspiration from osknows and great code samples from here and here. Thought I would share it in case others found it useful. First the complete module

'looping through, parent and child (see also callbacks for lpEnumFunc)
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, _
                                                       ByVal lParam As Long) As Long

Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, _
                                                            ByVal lpEnumFunc As Long, _
                                                            ByVal lParam As Long) As Long

'title of window
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long

Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, _
                                                                                ByVal lpString As String, _
                                                                                ByVal cch As Long) As Long


'class of window object
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
                                                                          ByVal lpClassName As String, _
                                                                          ByVal nMaxCount As Long) As Long

'control window display
Private Declare Function ShowWindow Lib "user32" (ByVal lHwnd As Long, _
                                                  ByVal lCmdShow As Long) As Boolean
Private Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long

Public Enum swcShowWindowCmd
    swcHide = 0
    swcNormal = 1
    swcMinimized = 2 'but activated
    swcMaximized = 3
    swcNormalNoActivate = 4
    swcShow = 5
    swcMinimize = 6 'activates next
    swcMinimizeNoActivate = 7
    swcShowNoActive = 8
    swcRestore = 9
    swcShowDefault = 10
    swcForceMinimized = 11
End Enum


'get application object using accessibility
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 Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, _
                                                    ByRef lpiid As GUID) As Long

'Const defined in winuser.h
Private Const OBJID_NATIVEOM    As Long = &HFFFFFFF0
'IDispath pointer to native object model
Private Const Guid_Excel     As String = "{00020400-0000-0000-C000-000000000046}"

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

'class names to search by (Excel, in this example, is XLMAIN)
Private mstrAppClass            As String
'title (a.k.a. pathless filename) to search for
Private mstrFindTitle           As String
'resulting handle outputs - "default" app instance and child with object
Private mlngFirstHwnd           As Long
Private mlngChildHwnd           As Long

'------
'replacement GetObject
'------
Public Function GetExcelWbk(pstrFullName As String, _
                   Optional pbleShow As Boolean = False, _
                   Optional pbleWasOpenOutput As Boolean) As Object

    Dim XLApp           As Object
    Dim xlWbk           As Object
    Dim strWbkNameOnly  As String

    Set XLApp = GetExcelAppForWbkPath(pstrFullName, pbleWasOpenOutput)

    'other stuff can be done here if the app needs to be prepared for the load

    If pbleWasOpenOutput = False Then
        'load it, without flicker, if you plan to show it
        If pbleShow = False Then
            XLApp.ScreenUpdating = False
        End If
        Set xlWbk = XLApp.Workbooks.Open(pstrFullName)
    Else
        'get it by its (pathless, if saved) name
        strWbkNameOnly = PathOrFileNm("FileNm", pstrFullName)
        Set xlWbk = XLApp.Workbooks(strWbkNameOnly)
    End If

    Set GetExcelWbk = xlWbk

    Set xlWbk = Nothing
    Set XLApp = Nothing
End Function

Private Function GetExcelAppForWbkPath(pstrFullName As String, _
                                       pbleWbkWasOpenOutput As Boolean, _
                              Optional pbleLoadAddIns As Boolean = True) As Object

    Dim XLApp           As Object
    Dim bleAppRunning   As Boolean
    Dim lngHwnd         As Long

    'get a handle, and determine whether it's for a workbook or an app instance
    lngHwnd = WbkOrFirstAppHandle(pstrFullName, pbleWbkWasOpenOutput)

    'if a handle came back, at least one instance of Excel is running
    '(this isnt' particularly useful; just check XLApp.Visible when you're done getting/opening;
    'if it's a hidden instance, it wasn't running)
    bleAppRunning = (lngHwnd > 0)

    'get an app instance.
    Set XLApp = GetAppForHwnd(lngHwnd, pbleWbkWasOpenOutput, pbleLoadAddIns)

    Set GetExcelAppForWbkPath = XLApp

    Set XLApp = Nothing
    Exit Function
End Function

Private Function WbkOrFirstAppHandle(pstrFullName As String, _
                                     pbleIsChildWindowOutput As Boolean) As Long

    Dim retval  As Long

    'defaults
    mstrAppClass = "XLMAIN"
    mstrFindTitle = PathOrFileNm("FileNm", pstrFullName)
    mlngFirstHwnd = 0
    mlngChildHwnd = 0

    'find
    retval = EnumWindows(AddressOf EnumWindowsProc, 0)

    If mlngChildHwnd > 0 Then
        pbleIsChildWindowOutput = True
        WbkOrFirstAppHandle = mlngChildHwnd
    Else
        WbkOrFirstAppHandle = mlngFirstHwnd
    End If

    'clear
    mstrAppClass = ""
    mstrFindTitle = ""
    mlngFirstHwnd = 0
    mlngChildHwnd = 0
End Function

Private Function GetAppForHwnd(plngHWnd As Long, _
                               pbleIsChild As Boolean, _
                               pbleLoadAddIns As Boolean) As Object
On Error GoTo HandleError

    Dim XLApp   As Object
    Dim AI      As Object

    If plngHWnd > 0 Then
        If pbleIsChild = True Then
            'get the parent instance using accessibility
            Set XLApp = GetExcelAppForHwnd(plngHWnd)
        Else
            'get the "default" instance
            Set XLApp = GetObject(, "Excel.Application")
        End If
    Else
        'no Excel running
        Set XLApp = CreateObject("Excel.Application")
        If pbleLoadAddIns = True Then
            'explicitly reload add-ins (automation doesn't)
            For Each AI In XLApp.AddIns
                If AI.Installed Then
                    AI.Installed = False
                    AI.Installed = True
                End If
            Next AI
        End If
    End If

    Set GetAppForHwnd = XLApp

    Set AI = Nothing
    Set XLApp = Nothing
    Exit Function
End Function

'------
'API wrappers and utilities
'------
Public Function uWindowClass(ByVal hWnd As Long) As String
    Dim strBuffer   As String
    Dim retval      As Long
    strBuffer = Space(256)
    retval = GetClassName(hWnd, strBuffer, 255)
    uWindowClass = Left(strBuffer, retval)
End Function

Public Function uWindowTitle(ByVal hWnd As Long) As String
    Dim lngLen      As Long
    Dim strBuffer   As String
    Dim retval      As Long

    lngLen = GetWindowTextLength(hWnd) + 1
    If lngLen > 1 Then
        'title found - pad buffer
        strBuffer = Space(lngLen)
        '...get titlebar text
        retval = GetWindowText(hWnd, strBuffer, lngLen)
        uWindowTitle = Left(strBuffer, lngLen - 1)
    End If
End Function

Public Sub uShowWindow(ByVal hWnd As Long, _
              Optional pShowType As swcShowWindowCmd = swcRestore)
    Dim retval  As Long
    retval = ShowWindow(hWnd, pShowType)

    Select Case pShowType
        Case swcMaximized, swcNormal, swcRestore, swcShow
            BringWindowToTop hWnd
            SetFocus hWnd
    End Select

End Sub

Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim strThisClass    As String
    Dim strThisTitle    As String
    Dim retval          As Long
    Dim bleMatch        As Boolean

    'mlngWinCounter = mlngWinCounter + 1
    'type of window is all you need for parent
    strThisClass = uWindowClass(hWnd)
    bleMatch = (strThisClass = mstrAppClass)

    If bleMatch = True Then
        strThisTitle = uWindowTitle(hWnd)
        'Debug.Print "Window #"; mlngWinCounter; " : ";
        'Debug.Print strThisTitle; "(" & strThisClass & ") " & hWnd
        If mlngFirstHwnd = 0 Then mlngFirstHwnd = hWnd

        'mlngChildWinCounter  0
        retval = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0)

        If mlngChildHwnd > 0 Then
        'If mbleFindAll = False And mlngChildHwnd > 0 Then
            'stop EnumWindows by setting result to 0
            EnumWindowsProc = 0
        Else
            EnumWindowsProc = 1
        End If
    Else
        EnumWindowsProc = 1
    End If
End Function

Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim strThisClass    As String
    Dim strThisTitle    As String
    Dim retval          As Long
    Dim bleMatch        As Boolean

    strThisClass = uWindowClass(hWnd)
    strThisTitle = uWindowTitle(hWnd)

    If Len(mstrFindTitle) > 0 Then
        bleMatch = (strThisTitle = mstrFindTitle)
    Else
        bleMatch = True
    End If

    If bleMatch = True Then
        mlngChildHwnd = hWnd
        EnumChildProc = 0
    Else
        EnumChildProc = 1
    End If

End Function

Public Function GetExcelAppForHwnd(pChildHwnd As Long) As Object
    Dim o       As Object
    Dim g       As GUID
    Dim retval  As Long

    'for child objects only, e.g. must use a loaded workbook to get its parent Excel.Application

    'make a valid GUID type
    retval = IIDFromString(StrPtr(Guid_Excel), g)
    'get
    retval = AccessibleObjectFromWindow(pChildHwnd, OBJID_NATIVEOM, g, o)
    If retval >= 0 Then
        Set GetExcelAppForHwnd = o.Application
    End If
End Function

Public Function PathOrFileNm(pstrPathOrFileNm As String, _
                             pstrFileNmWithPath As String)
On Error GoTo HandleError

    Dim i       As Integer
    Dim j       As Integer
    Dim strChar As String

    If Len(pstrFileNmWithPath) > 0 Then
        i = InStrRev(pstrFileNmWithPath, "\")
        If i = 0 Then
            i = InStrRev(pstrFileNmWithPath, "/")
        End If

        If i > 0 Then
            Select Case pstrPathOrFileNm
                Case "Path"
                    PathOrFileNm = Left(pstrFileNmWithPath, i - 1)
                Case "FileNm"
                    PathOrFileNm = Mid(pstrFileNmWithPath, i + 1)
            End Select
        ElseIf pstrPathOrFileNm = "FileNm" Then
            PathOrFileNm = pstrFileNmWithPath
        End If
    End If

End Function

然后一些样本/测试代码。

And then some sample/test code.

Public Sub Test_GetExcelWbk()
    Dim MyXLApp         As Object
    Dim MyXLWbk         As Object
    Dim bleXLWasRunning As Boolean
    Dim bleWasOpen      As Boolean

    Const TESTPATH      As String = "C:\temp\MyFlickerbook.xlsx"
    Const SHOWONLOAD    As Boolean = False

    Set MyXLWbk = GetExcelWbk(TESTPATH, SHOWONLOAD, bleWasOpen)

    If Not (MyXLWbk Is Nothing) Then
        Set MyXLApp = MyXLWbk.Parent
        bleXLWasRunning = MyXLApp.Visible

        If SHOWONLOAD = False Then
            If MsgBox("Show " & TESTPATH & "?", vbOKCancel) = vbOK Then
                MyXLApp.Visible = True
                MyXLApp.Windows(MyXLWbk.Name).Visible = True
            End If
        End If
        If bleWasOpen = False Then
            If MsgBox("Close " & TESTPATH & "?", vbOKCancel) = vbOK Then
                MyXLWbk.Close SaveChanges:=False

                If bleXLWasRunning = False Then
                    MyXLApp.Quit
                End If
            End If
        End If
    End If

    Set MyXLWbk = Nothing
    Set MyXLApp = Nothing
End Sub

希望有人发现这有用。