open another program and shift focus to it

[Techworks]

I have the following code to open my third party file manager at a specific folder, which works, but its not shifting the focus to it, its stays on Access

How do I get the other app to come to hte front?

-----------------------------
Dim vTemp As Variant
Dim vPath As Variant
Dim vString As Variant

vPath = Me.txtPJ_FilePath

vString = "C:\Program Files\GPSoftware\Directory Opus\dopusrt.exe /cmd Go " & vPath & ""
'Debug.Print vString

'vbHide 0
'vbNormalFocus 1
'vbMinimizedFocus 2
'vbMaximizedFocus 3
'vbNormalNoFocus 4
'vbMinimizedNoFocus 6

vTemp = Shell(vString, vbNormalFocus)
-------------------------------
I'm expecting vbNornalfocus to shift the focus to the app opened by the shell command, but it does not if the app is already open, which it always is as I keep DO open all the time

I've tried the following two common approaches that test the app is open:
----------------------
Public Sub OpenDirectoryOpus(vPath As Variant)

Dim vString As Variant

vString = "C:\Program Files\GPSoftware\Directory Opus\dopusrt.exe /cmd Go " & vPath & ""
Debug.Print vString

'Launch application if not already open
If vPID = 0 Then 'Application not already open
101:
vPID = Shell(vString, vbNormalFocus)
'AppActivate vPID

Else 'Application already open so reactivate
On Error GoTo 101
AppActivate (vPID)
End If

Debug.Print "AppActivate (" & vPID & ")"

End Sub

Public Sub OpenDirectoryOpus2(vPath As Variant)

'Launch folder if not already open
Dim vString As Variant
Dim strDirectory As String
Dim pID As Variant, sh As Variant
Dim w As Object

vString = "C:\Program Files\GPSoftware\Directory Opus\dopusrt.exe /cmd Go " & vPath & ""
strDirectory = vPath
On Error GoTo 102:
Set sh = CreateObject("shell.application")
For Each w In sh.Windows
If w.Document.folder.self.path = strDirectory Then 'if already open, activate it
w.Visible = False
w.Visible = True
Exit Sub
End If
Next
'if you get here, the folder isn't open so open it
'vbHide 0
'vbNormalFocus 1
'vbMinimizedFocus 2
'vbMaximizedFocus 3
'vbNormalNoFocus 4
'vbMinimizedNoFocus 6

pID = Shell(vString, vbNormalFocus)
102:

End Sub
-----------------------
Again I was expecting AppActivate to work but it does not.

Surely there is a simple way to get the other app to be the focus?

Thanks in advance

Grant

 

[ozinm]

Something like this should work

Option Explicit
      Private Declare Function BringWindowToTop Lib "user32" (ByVal _
         hwnd As Long) As Long

      Private Declare Function FindWindow Lib "user32" Alias _
         "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName _
         As Any) As Long

      Private Sub RunCalc()
         Dim X As Long
         X = Shell("Calc.exe", 1)
         ' X should not = 0 if calc.exe launched
      End Sub

      Private function FindCalc() as long
       Dim THandle As Long
         THandle = FindWindow(vbEmpty, "Calculator")
         ' if THandle = 0 Then calc is NOT running
         FindCalc=THandle
      End Sub

      Private Sub FocusCalc()
         Dim iret As Long
         iret = BringWindowToTop(FindCalc())
      End Sub

 

[Techworks]

Thanks, one question with this approach is that the following line

FindWindow(vbEmpty, "Calculator")

I assume "Calculator" is the app title "name", which shows in the apps title bar, and also is the task that shows in the Windows Task Manager. With the app I'm opening (Directory Opus), the name that shows in the app title bar is the folder that has been selected, so its constantly changing. This is also what show in the Windows Task manager.

I've tried modifying your code to pass the app name as a variant, but this line wont accept a variant

THandle = FindWindow(vbEmpty, "Calculator")

See code
---------------------------
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName _
As Any) As Long

Private Sub RunDO(vPath As Variant)
Dim X As Long
Dim vString As Variant

vString = "C:\Program Files\GPSoftware\Directory Opus\dopusrt.exe /cmd Go " & vPath & ""
X = Shell(vString, 1)
' X should not = 0 if calc.exe launched
End Sub

Private Function FindDO(vName As Variant) As Long
Dim THandle As Long
THandle = FindWindow(vbEmpty, vName)
' if THandle = 0 Then calc is NOT running
FindCalc = THandle
End Function

Private Sub FocusDO(vName As Variant)
Dim iret As Long
iret = BringWindowToTop(FindDO(vName))
End Sub
------------------------------------

I also note your function declaration is "FindWindowA", whereas further down you use "FindWindow"

Is that correct??