switch application

[Jaye7]

I have a script to open programs, however is there a script that can just switch to the program if it is already open.

i.e. switch to internet explorer.

 

[Leith Ross]

Hello Jaye7,

Copy this code into a standard VBA Module in your workbook project. This code works with Windows 2000 through 2003, but has not been tested on Windows 2007 and up. These API calls are for 32 bit platforms and will not run on 64 bit systems.

'Written: Apirl 24, 2008
'Updated: December 24, 2010 - Finds window using full or partial title
'Author:  Leith Ross
'Summary: Activates an running Application using part or all of the title.
'         Works with Windows 2000 to XP. Untested with Windows 2007 and up.

Option Explicit

 Private Declare Function FindWindowA _
   Lib "User32.dll" _
     (ByVal lpszClass As String, _
      ByVal lpszWindow As String) As Long
      
'Checks if the window is minimized to the TaskBar
 Private Declare Function IsIconic _
   Lib "User32.dll" _
     (ByVal hWnd As Long) As Long
 
'Returns the handle to the window currently receiving input
 Private Declare Function GetForegroundWindow _
   Lib "User32.dll" () As Long

'Directs User Input to the specified Window
'Success gives a Non Zero Return Value
 Public Declare Function SetForegroundWindow _
  Lib "User32.dll" _
   (ByVal hWnd As Long) As Long
   
'Bring Window to the Top of the Z-Order
 Private Declare Function BringWindowToTop _
  Lib "User32.dll" _
   (ByVal hWnd As Long) As Long

 Private Declare Function AttachThreadInput _
   Lib "User32.dll" _
     (ByVal idAttach As Long, _
      ByVal idAttachTo As Long, _
      ByVal fAttach As Long) As Long
      
'The return value is the identifier of the thread that created the window.
 Private Declare Function GetWindowThreadProcessId _
   Lib "User32.dll" _
     (ByVal hWnd As Long, _
      ByRef lpdwProcessID As Long) As Long

'Function to Change how Window is Displayed
 Private Declare Function ShowWindow _
  Lib "User32.dll" _
   (ByVal hWnd As Long, _
    ByVal nCmdShow As Long) As Long
  
'Constants for ShowWindow (nCmdShow)
 Const SW_HIDDEN As Long = 0
 Const SW_NORMAL As Long = 1
 Const SW_MINIMIZED As Long = 2
 Const SW_MAXIMIZED As Long = 3
 Const SW_NOTACTIVE As Long = 4
 Const SW_UNHIDDEN As Long = 5
 Const SW_MINWITHFOCUS As Long = 6
 Const SW_MINNOTACTIVE As Long = 7
 Const SW_RESTORE As Long = 9

 Private Declare Function GetWindow _
   Lib "User32.dll" _
     (ByVal hWnd As Long, _
      ByVal wCmd As Long) As Long

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

 Private Declare Function GetDesktopWindow _
   Lib "User32.dll" () As Long

Function GetHwnd(Window_Title As String) As Long

  Dim hWnd As Long
  Dim RetVal As Long
  Dim Title As String
    
  Const GW_HWNDNEXT As Long = 2
  Const GW_CHILD As Long = 5
  
    hWnd = GetWindow(GetDesktopWindow, GW_CHILD)
    
    While hWnd
      Title = String(512, Chr$(0))
      RetVal = GetWindowText(hWnd, Title, Len(Title))
        If LCase(Title) Like "*" & LCase(Window_Title) & "*" Then
           GetHwnd = hWnd: Exit Function
        End If
      hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Wend

End Function

Sub ActivateWindow(ByVal Window_Title As String)

  Dim AppHwnd As Long
  Dim NewPID As Long
  Dim NewAppThreadID As Long
  Dim RetVal As Long
  Dim ThisPID As Long
  Dim ThisAppThreadID As Long
  Dim WndTitle As String
  
    'Build the Window Title
     WndTitle = Window_Title
     
    'Get a handle on the Window you want to send the mouse clicks to
     AppHwnd = GetHwnd(WndTitle)
      
    'Was window found?
     If AppHwnd <> 0 Then
       'Application window found by the caption
        ThisAppThreadID = GetWindowThreadProcessId(GetForegroundWindow, ThisPID)
        NewAppThreadID = GetWindowThreadProcessId(AppHwnd, NewPID)
         
       'Attach the other Application's thread input to this one
        Call AttachThreadInput(ThisAppThreadID, NewAppThreadID, True)
        
       'Make the other Application the top window
        RetVal = SetForegroundWindow(AppHwnd)
         
       'Detach the other Application's thread input
        Call AttachThreadInput(ThisAppThreadID, NewAppThreadID, False)
       
          If RetVal <> 0 Then
            'Maximize the window if it's been minimized
            'or just show it if it's already opened.
             If IsIconic(AppHwnd) Then
               Call ShowWindow(AppHwnd, SW_MAXIMIZED)
             Else
               Call ShowWindow(AppHwnd, SW_RESTORE)
             End If
          Else
            MsgBox "Can't Bring Window to the Foreground."
          End If
     Else
       'Failed to find the window caption
       '(the app is probably closed or the wrong window name is passed)
        MsgBox "Application Window '" & WndTitle & "' Not Found."
     End If

End Sub

Add the line below to your code to activate the Internet Explorer window from Excel. The macro ignores case in the window's title.

    ActivateWindow "Internet Explorer"

Sincerely,
Leith Ross

 

[Jaye7]

Thanks Leith, that works great, just one thing.

If the program that I want to view is a different program i.e. we have a work software called Mo Pro, how can I retrieve the info that would then call that software/ program instead of internet explorer.

 

[Jaye7]

Leith,

I have worked it out, thanks very much, maybe you can help with the following.

http://www.mrexcel.com/forum/showthread.php?p=2665104#post2665104

 

[Jaye7]

Leith,

I have a problem with teh script.

When I run it it is making the titlebar on internet explorer and firefox disappear, also it is resizing the windows which I don't want, I just want them to maximise, can you please help with this.

 

[Leith Ross]

Hello Jaye7,

I would need to see your workbook. Can you post it or would you rather email it to me?

Sincerely,
Leith Ross

 

[Jaye7]

Hi Leith,

I have worked it out, it wasn't your code (SORRY), I had another code that removes the caption/title from my userform when it activates and then when combined with your code it is also removing the caption from the other screens also as when I click on my commandbutton it brings i.e. internet explorer to the front and then the caption is removed when it should only remove the caption from the userform, I will have to try and fix it to only remove the caption from the userform.

the remove caption script is.

'Returns the Window Handle of the Window
'that is accepting User input.
 Public Declare Function GetForegroundWindow _
   Lib "User32.dll" () As Long
 Private Declare Function GetWindowLong _
  Lib "User32.dll" _
    Alias "GetWindowLongA" _
     (ByVal hWnd As Long, _
      ByVal nIndex As Long) As Long
 
 Private Declare Function SetWindowLong _
  Lib "User32.dll" _
    Alias "SetWindowLongA" _
     (ByVal hWnd As Long, _
      ByVal nIndex As Long, _
      ByVal dwNewLong As Long) As Long
'Redraw the Icons on the Window's Title Bar
 Private Declare Function DrawMenuBar _
   Lib "User32.dll" _
    (ByVal hWnd As Long) As Long
 Private Const GWL_STYLE As Long = (-16)
 Private Const WS_CAPTION = &HC00000
Sub RemoveCaption()
  Dim BitMask As Long
  Dim hWnd As Long
  Dim WindowStyle As Long
 
    hWnd = GetForegroundWindow
    WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
    BitMask = WindowStyle And (Not WS_CAPTION)
    Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
    Call DrawMenuBar(hWnd)
 
End Sub

Thanks Leith

 

[Jaye7]

I have sorted it out now, thanks very much for your help Leith, much appreciated.

 

[Leith Ross]

Hello Jaye7,

I have been out for awhile. It appears you figured it. The safest way to remove the title bar is to pass the hWnd in (Window Handle) to the Sub, like this...

Sub RemoveCaption(ByVal hWnd As Long)
  Dim BitMask As Long
  Dim WindowStyle As Long
 
    WindowStyle = GetWindowLong(hWnd, GWL_STYLE)
    BitMask = WindowStyle And (Not WS_CAPTION)
    Call SetWindowLong(hWnd, GWL_STYLE, BitMask)
    Call DrawMenuBar(hWnd)
 
End Sub

In the UserForm_Activate event you can make this call to remove only the UserForm caption.

Private Sub UserForm_Activate()
  RemoveCaption GetForegroundWindow
End Sub

Sincerely,
Leith Ross
</pre>