How can I stop the flickering of an Excel workbook during automation?

Question

I use GetObject from the workbook path to either create a new one or grab an existing Excel instance. If it captures an existing user instance, the application window is visible; if the book’s path in question is closed, it will open and hide, but not before it starts flashing on the screen. Application.ScreenUpdating does not help.

I don’t think I can use the Win32Api LockWindowUpdate call because I don’t know if I get it or create it before the file is opened. Is there any other VBA way (like WinAPI) to freeze the screen long enough to get an object?

EDIT : just clarify, because the first answer involves using the Application object ... These are the steps to reproduce this behavior. 1. Open Excel - make sure that you use only one instance - save and close the default workbook. Excel window is now visible, but "empty" 2. Open Powerpoint or Word, insert the module, add the following code

 Public Sub Open_SomeWorkbook() Dim MyObj As Object Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'uncomment the next line to see the workbook again' 'MyObj.Parent.Windows(MyObj.Name).Visible = True' 'here how you work with the application object... after the fact' Debug.Print MyObj.Parent.Version End Sub 

• Note the flickering when Excel opens a file in an existing instance and then hides it ... because it automates
• Please also note, however, that there is no work with the application object until it flickers. That is why I am looking for some larger API method for freezing the screen.

Answer 1

In the end, I ended up working with GetObject because it was not granular enough and wrote my own flickering knife, with some inspiration from osknows and great code examples from here and here . Thought I'd share it if others found it useful. Full module first

 '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 (aka 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 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 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, eg 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 

Hope someone finds this helpful.

Answer 2

Try

 Application.VBE.MainWindow.Visible = False 

If this does not work, try

 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal ClassName As String, ByVal WindowName As String) As Long Private Declare Function LockWindowUpdate Lib "user32" _ (ByVal hWndLock As Long) As Long Sub EliminateScreenFlicker() Dim VBEHwnd As Long On Error GoTo ErrH: Application.VBE.MainWindow.Visible = False VBEHwnd = FindWindow("wndclass_desked_gsk", _ Application.VBE.MainWindow.Caption) If VBEHwnd Then LockWindowUpdate VBEHwnd End If ''''''''''''''''''''''''' ' your code here ''''''''''''''''''''''''' Application.VBE.MainWindow.Visible = False ErrH: LockWindowUpdate 0& End Sub 

Both are found here. Resolving Screen Flicker During VBProject Code

Answer 3

Well, you did not mention several instances ... [1. Open Excel - make sure you use only one instance] :)

How about something like that .....

 Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal lHwnd As Long, _ ByVal lCmdShow As Long) As Boolean Public Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long Sub GetWindowHandle() Const SW_HIDE As Long = 0 Const SW_SHOW As Long = 5 Const SW_MINIMIZE As Long = 2 Const SW_MAXIMIZE As Long = 3 'Const C_WINDOW_CLASS = "XLMAIN" Const C_WINDOW_CLASS = vbNullString Const C_FILE_NAME = "Microsoft Excel - Flickerbook.xlsx" 'Const C_FILE_NAME = vbNullString Dim xlHwnd As Long xlHwnd = FindWindow(lpClassName:=C_WINDOW_CLASS, _ lpWindowName:=C_FILE_NAME) 'Debug.Print xlHwnd if xlHwnd = 0 then Dim MyObj As Object Dim objExcel As Excel.Application Set objExcel = GetObject(, "Excel.Application") objExcel.ScreenUpdating = False Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'uncomment the next line to see the workbook again' 'MyObj.Parent.Windows(MyObj.Name).Visible = True 'here how you work with the application object... after the fact' Debug.Print MyObj.Parent.Version MyObj.Close objExcel.ScreenUpdating = True else 'Either HIDE/SHOW or MINIMIZE/MAXIMISE ShowWindow xlHwnd, SW_HIDE Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'manage MyObj ShowWindow xlHwnd, SW_SHOW 'Or LockWindowUpdate then Unlock LockWindowUpdate xlHwnd Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'manage MyObj LockWindowUpdate 0 end if ' 'Get Window Name ' Dim strWindowTitle As String ' strWindowTitle = Space(260) ' We must allocate a buffer for the GetWindowText function ' Call GetWindowText(xlHwnd, strWindowTitle, 260) ' debug.print (strWindowTitle) End Sub