×

注意!页面内容来自https://www.mrexcel.com/board/threads/open-calc-exe-from-vba.265070/,本站不储存任何内容,为了更好的阅读体验进行在线解析,若有广告出现,请及时反馈。若您觉得侵犯了您的利益,请通知我们进行删除,然后访问 原网页

You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.

Open calc.exe from VBA

ScottyG

Board Regular
Joined
Mar 302006
Messages
62
I use this to open Windows calculator but how can I modifiy it to NOT open another instance if calc.exe is already open?


Sub StartCalculator()
Dim Program As String
Dim TaskID As Double
On Error Resume Next
Program = "calc.exe"
TaskID = Shell(Program1)
If Err <> 0 Then
MsgBox "Can't start " & Program
End If
End Sub
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact matchthe VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Good afternoon ScottyG

Does this work OK for you :

Code:
Sub Calculator()
Dim Program As StringTaskID As Double
Program = "calc.exe"
On Error Resume Next
AppActivate "Calculator"
If Err <> 0 Then
Err = 0
TaskID = Shell(Program1)
If Err <> 0 Then MsgBox "Can't start " & Program
End If
End Sub

HTH

DominicB
 
Upvote 0
Re: Calc

Dominic,

Yesthat solved the problem of opening another calculator but... if the calclulator is minimizedit doesn't maximize it. Is there an extra bit of code to make it pop back open - something like MAXIMIZED FOCUS or something?

Scott
 
Upvote 0
Re: Calc

I am probably going to get slapped for the epic thread resurrection...... so will start with "i'm sorry!" Buti think/hope others may find this additional info helpful if they land here from a search result like i did.

I found this thread because i needed to do the same as the OPbuti had an additional issuei could not use the title "Calculator" in the AppActivate callbecause i have a desktop gadget of the same name runningand windoze got confused between the 2 !!


sowith a little searching and readingand general head scratching i came up with 2 scenariosboth workand can be used to achieve the goalboth will require the public declaration

Option 1:
This uses a function to search the running processes for the name you pass itand it returns true or false depending on the number of instances found.
From this you can then trigger either a new instance of your selected applicationor re-acctivate and bring into focus an existing one

Code:
Public vPID As Variant

Sub Launch_Calculator()
    If IsProcessRunning("calc.exe") = True Then
        On Error GoTo Reload                ' Open new instance of calculator in event of error
        AppActivate (vPID)                  ' Reactivate calculator process using Public declared variant
        SendKeys "%{Enter}"                 ' Bring it back into focus if user minimises it
    Else
Reload:
        vPID = Shell("calc.exe"1)         ' Run Calculator
    End If
    On error GoTo 0
End Sub
'
'


' Function to check for running application by its process name
Function IsProcessRunning(sApp As String)
On Error GoTo Skip
    Dim objList As Object
    Set objList = GetObject("winmgmts:") _
        .ExecQuery("select * from win32_process where name='" & sApp & "'")
    If objList.Count > 0 Then
        IsProcessRunning = True
        Exit Function
    Else
        IsProcessRunning = False
        Exit Function
    End If
Skip:
IsProcessRunning = False
End Function
'


Option 2:
This does not use the function to identify if the application in question is running or notit simply relies on the fact that on starting itthe Process ID gets assigned to the public variantand that can be used by AppActivate just like it uses a titleOption 1 has a small advantage in that it will see any copy of calculator that was already running on opening of your workbookOption 2 will not.

Code:
Public vPID As Variant

Sub OpenApplication()
    If vPID = 0 Then                    ' Application not already open
ReOpen:
        vPID = Shell("calc.exe"vbNormalFocus)    ' Launch application
    Else                                ' Application already open
        On Error GoTo ReOpen            ' Jump back and open new instance of application in the event of an error
        AppActivate (vPID)              ' Re-activate application
        SendKeys "%{Enter}"             ' Bring application back into focus if user minimises it
    End If
    On Error GoTo 0
End Sub


One point to notei'm assigning the macro to a button object on my worksheetand it works fineif your in the VBA editor and try and run the code using F5 or the debuggerit'll likely have a bit of a fit at the sendkeys linebut it does work fine when triggered from a worksheet objectsendkeys is not the most elegant way to drag the application back kicking and screaming from the task tray after it's been minimisedbut it also doesn't require an API and huge amounts of code!
 
Last edited:
Upvote 0
Re: Calc

oopsi screwed the code on Option 1and i can't edit my last posti forgot to handle existing copies of it running when you open the workbookthis amended code should deal with thatand be able to cope with up to 2 copies of the same application (in this case calculator) running at the same timeregardless of whether both were open at the startor if you open one of them externally from excel. It should alternate between them as you repeat press your object button as well if 2 are open.


Code:
Public vPID As Variant

Sub Launch_Calculator()
    If IsProcessRunning("calc.exe") = True Then     ' Check if Calculator is already running
        On Error GoTo Reload                        ' Open new instance of calculator in event of error
        AppActivate (vPID)                          ' Re-activate using pre-existing process ID
        SendKeys "%{Enter}"                         ' Bring it back into focus if it was minimised
    Else
Reload:
        vPID = Shell("calc.exe"1)                 ' Run Calculator
    End If
    On Error GoTo 0
End Sub
'
'


' Function to check for running application by its process name
Function IsProcessRunning(sApp As String)
On Error GoTo Skip
    Dim objList As Object
    Set objList = GetObject("winmgmts:").ExecQuery("Select ProcessID from Win32_Process where Name='" & sApp & "'")
    If objList.Count > 0 Then
        IsProcessRunning = True
        For Each objProcess In objList
            If vPID <> objProcess.ProcessID Then
                vPID = objProcess.ProcessID
                Exit Function
            End If
        Next
    Else
        IsProcessRunning = False
        Exit Function
    End If
Skip:
IsProcessRunning = False
End Function
'
 
Upvote 0
Back
Top