VBA - createobject - If

[ina]

Hello guys,

I need some help with this algorithm in VBA (createobject). My function
should open a instance of my program if the program is already open it
don't have to open it again. The problem is that this function open the
program twice, trice ... so on. Could someone help me on that

' I have this function to Open a program
Function OpenPHObject() As Object


Dim oExec As Object
Dim WshShell As Object
Dim bolPack As Boolean

' I set up a Object
Set WshShell = CreateObject("Wscript.Shell")

'if the program is not open, open it
If Err <> 0 Then
Set oExec = WshShell.Exec("C:\Program Files\PH\PH.exe")
bolPack = True

Else
Msgbox "the program is open"

End If

DoEvents

On Error Resume Next

'Call the function as argument the Program object
Set OpenPHObject = oExec



errorHandler:
MsgBox Err.Number & " " & Err.Description


End Function

 

[paul.robinson]

Hi
The Err object persists through the session, so maybe that is causing
multiple instances? Try

On error resume next
Err.Clear
Set WshShell = CreateObject("Wscript.Shell")
'if the program is not open, open it
If Err <> 0 Then
Set oExec = WshShell.Exec("C:\Program Files\PH\PH.exe")
bolPack = True
Else
Msgbox "the program is open"
End If

on error goto 0

regards
Paul

 

[ina]

yes it is cool thank you because it works but when I try to call this
sub. I have an error run-time 91 error run-time error 91 object
variable or with block variable not set

do you know why?

Option Explicit

Sub test()

Dim oExec As Object

Set oExec = OpenPHObject()

Application.Wait (Now + TimeValue("0:00:10"))

Call CHObject(oExec)

End Sub


Function ClosePHObject(oExec As Object)

Dim WshShell As Object

'oExec.Quit
oExec.Terminate
Set WshShell = Nothing
Set oExec = Nothing

End Function