Open Excel from Access and Bring to the front

[hudaz]

Hi Everyone,

I've hit a brick wall when trying to open excel from access and bring it to the front.

I've managed to do the first part with the code below but the Excel document is opening behind access and i need it to come to the front.

Does anybody have any idea's on how to rectify this or knows of any work around's ?

Thanks

Private Sub Command15_Click()

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True

xlApp.Workbooks.Open "O:\Mercury\DASHBOARD\L13_DASHBOARD_1.2.XLSM", True, False

Set xlApp = Nothing

End Sub

 

[Ranman256]

usu when you start xl it comes to the front,
but after the DIM statement, put:
docmd.minimize

 

[JHB]

Try the below, (insert it as last line in your code).

xlApp.Application.Activate

 

[arnelgp]

with your current code, it will open excel for a little while then just close again, because of this code:

set xlApp = Nothing

 

[hudaz]

Hi all,

thanks for your suggestions but I've had no success so far.

Ranman256, when i try your suggestion it just minimises one dialog box i have another still open as well as Access.

JHB, Your suggestion pulls up an error stating the the object does not support this property or method.

arnelgp, With your suggestion i removed the code and the excel document still opened up hidden behind access.

Any other suggestions would be greatly appreciated and thanks for your help so far

 

[arnelgp]

put in a module:

' arnel gp
'
#If Win64 Then
Private Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr

#Else
Private Declare Function BringWindowToTop Lib "user32" ( _
    ByVal HWnd As Long) As Long
    
Private Declare Function SetFocus Lib "user32" ( _
    ByVal HWnd As Long) As Long
#End If
#If Win64 Then
Public Sub subBringToFront(XLHWnd As LongPtr)
#Else
Public Sub subBringToFront(XLHWnd As Long)
#End If
Dim Res As Long
        Res = BringWindowToTop(hwnd:=XLHWnd)
         
        If Res = 0 Then
            Debug.Print "Error With BringWindowToTop:  " & _
                CStr(err.LastDllError)
          Else
            '''''''''''''''''''''''''''''''''
            ' No error.
            ' Set keyboard input focus XLMAIN
            '''''''''''''''''''''''''''''''''
            SetFocus hwnd:=XLHWnd
        End If

End Sub

now modify your code to:

Private Sub Command15_Click()

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True

xlApp.Workbooks.Open "O:\Mercury\DASHBOARD\L13_DASHBOARD_1.2.XLSM", True, False

[COLOR=Blue]subBringToFront xlApp.hwnd[/COLOR]

End Sub

 

[hudaz]

Hi arnelgp,

Thanks for your help so far but unfortunately the code performs the same, it opens excel but it still just flashes in the task bar until you click on it. Any other suggestions ?, such a frustrating problem!

Thanks once again for taking the time to help arnelgp.

 

[arnelgp]

any way heres my last attemp.
call the function within your code:

FnSetForeGroundWindow "*L13_DASHBOARD_1.2.XLSM*"

copy the two codes in Separate Modules:

#If Win64 Then
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
'Could use global variables instead, but this is nicer.
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters

    strTitle As String  'INPUT
    hwnd As LongPtr        'OUTPUT

End Type
#Else
                    
Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long
'Could use global variables instead, but this is nicer.
'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters

    strTitle As String  'INPUT
    hwnd As Long        'OUTPUT

End Type
#End If


#If Win64 Then
Public Function FnFindWindowLike(strWindowTitle As String) As LongPtr

#Else
Public Function FnFindWindowLike(strWindowTitle As String) As Long
#End If
    
    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = UCase(strWindowTitle) ' Input parameter
    

#If Win64 Then
    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
#Else
    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
#End If
    FnFindWindowLike = Parameters.hwnd
    
End Function
#If Win64 Then
Private Function EnumWindowProc(ByVal hwnd As LongPtr, _
                               lParam As FindWindowParameters) As LongPtr
#Else
Private Function EnumWindowProc(ByVal hwnd As Long, _
                               lParam As FindWindowParameters) As Long
#End If
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hwnd, strWindowTitle, 260)
   strWindowTitle = UCase(TrimNull(strWindowTitle)) ' Remove extra null terminator
                                          
   If strWindowTitle Like lParam.strTitle Then
   
        lParam.hwnd = hwnd 'Store the result for later.
        EnumWindowProc = 0 'This will stop enumerating more windows
   
   Else

        EnumWindowProc = 1

   End If
                           
End Function

Private Function TrimNull(strNullTerminatedString As String)

    Dim lngPos As Long

    'Remove unnecessary null terminator
    
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
   'Debug.Print TrimNull
End Function

#If Win64 Then
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" _
    (ByVal hwnd As LongPtr) As Long
    
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As LongPtr
     
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hwnd As LongPtr, _
     lpdwProcessId As Long) As Long
     
Private Declare PtrSafe Function IsIconic Lib "user32" _
    (ByVal hwnd As LongPtr) As Long
    
Private Declare PtrSafe Function ShowWindow Lib "user32" _
    (ByVal hwnd As LongPtr, _
     ByVal nCmdShow As Long) As Long
     
Private Declare PtrSafe Function AttachThreadInput Lib "user32" _
    (ByVal idAttach As Long, _
     ByVal idAttachTo As Long, _
     ByVal fAttach As Long) As Long
     
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" _
    () As LongPtr
#Else
Private Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hwnd As Long) As Long
    
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, _
     ByVal lpWindowName As String) As Long
     
Private Declare Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hwnd As Long, _
     lpdwProcessId As Long) As Long
     
Private Declare Function IsIconic Lib "user32" _
    (ByVal hwnd As Long) As Long
    
Private Declare Function ShowWindow Lib "user32" _
    (ByVal hwnd As Long, _
     ByVal nCmdShow As Long) As Long
     
Private Declare Function AttachThreadInput Lib "user32" _
    (ByVal idAttach As Long, _
     ByVal idAttachTo As Long, _
     ByVal fAttach As Long) As Long
     
Private Declare Function GetForegroundWindow Lib "user32" _
    () As Long
#End If
Private Const SW_RESTORE = 9
Private Const SW_SHOW = 5

Public Function FnSetForeGroundWindow(strWindowTitle As String) As Boolean

#If Win64 Then
    Dim MyAppHWnd As LongPtr
#Else
    Dim MyAppHWnd As Long
#End If
    Dim CurrentForegroundThreadID As Long
    Dim NewForegroundThreadID As Long
    Dim lngRetVal As Long
    
    Dim blnSuccessful As Boolean
    
    MyAppHWnd = FnFindWindowLike(strWindowTitle)
    
    If MyAppHWnd <> 0 Then
        
        'We've found the application window by the caption
            CurrentForegroundThreadID = GetWindowThreadProcessId(GetForegroundWindow(), ByVal 0&)
            NewForegroundThreadID = GetWindowThreadProcessId(MyAppHWnd, ByVal 0&)
    
        'AttachThreadInput is used to ensure SetForegroundWindow will work
        'even if our application isn't currently the foreground window
        '(e.g. an automated app running in the background)
            Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, True)
            lngRetVal = SetForegroundWindow(MyAppHWnd)
            Call AttachThreadInput(CurrentForegroundThreadID, NewForegroundThreadID, False)
            
        If lngRetVal <> 0 Then
        
            'Now that the window is active, let's restore it from the taskbar
            If IsIconic(MyAppHWnd) Then
                Call ShowWindow(MyAppHWnd, SW_RESTORE)
            Else
                Call ShowWindow(MyAppHWnd, SW_SHOW)
            End If
            
            blnSuccessful = True
        
        Else
        
            'MsgBox "Found the window, but failed to bring it to the foreground!"
        
        End If
        
    Else
    
        'Failed to find the window caption
        'Therefore the app is probably closed.
        'MsgBox "Application Window '" + strWindowTitle + "' not found!"
    
    End If
    
     FnSetForeGroundWindow = blnSuccessful
    
End Function