确定应用程序是否正在运行Excel

目标

使用“search”button打开一个自定义程序的Excel文件。 这个程序用于研究。 如果程序在用户点击button时已经打开，则popup并关注给定的程序。

现在的情况

以下是我正在尝试使用的代码：

searchbutton

Private Sub btnSearch_Click() Dim x As Variant Dim Path As String If Not IsAppRunning("Word.Application") Then Path = "C:\Tmp\MyProgram.exe" x = Shell(Path, vbNormalFocus) End If End Sub 

IsAppRunning（）

 Function IsAppRunning(ByVal sAppName) As Boolean Dim oApp As Object On Error Resume Next Set oApp = GetObject(, sAppName) If Not oApp Is Nothing Then Set oApp = Nothing IsAppRunning = True End If End Function 

只有当我把“Word.Application”作为可执行文件时，这个代码才能工作。 如果我试图把“MyProgram.Application”函数永远不会看到程序正在运行。 我怎样才能find“MyProgram.exe”目前正在打开？

此外，我需要把重点放在…

Answer 1

您可以通过获取打开的进程列表来更直接地检查。

这将根据进程名称进行search，并根据情况返回true / false。

 Sub exampleIsProcessRunning() Debug.Print IsProcessRunning("MyProgram.EXE") Debug.Print IsProcessRunning("NOT RUNNING.EXE") End Sub Function IsProcessRunning(process As String) Dim objList As Object Set objList = GetObject("winmgmts:") _ .ExecQuery("select * from win32_process where name='" & process & "'") If objList.Count > 0 Then IsProcessRunning = True Else IsProcessRunning = False End If End Function 

Answer 2

以下是我把search窗口放在前面的方法：

 Private Const SW_RESTORE = 9 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 Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Private Sub btnSearch_Click() Dim x As Variant Dim Path As String If IsProcessRunning("MyProgram.exe") = False Then Path = "C:\Tmp\MyProgram.exe" x = Shell(Path, vbNormalFocus) Else Dim THandle As Long THandle = FindWindow(vbEmpty, "Window / Form Text") Dim iret As Long iret = BringWindowToTop(THandle) Call ShowWindow(THandle, SW_RESTORE) End If End Sub 

现在，如果窗口最小化，用户再次点击searchbutton，窗口就会popup。

Answer 3

只是想说，谢谢你的解决scheme。 只是刚开始玩代码，想要自动化我的工作了一下。 这段代码将把当前select的Excel表单粘贴到一个已经打开的应用程序中，只需点击一下即可。 会让我的生活变得如此简单！

感谢分享

 Public Const SW_RESTORE = 9 Public Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Sub updatepart() ' ' updatepart Macro ' copies current selection ' finds and focuses on all ready running Notepad application called Test ' pastes value into Notepad document ' Keyboard Shortcut: Ctrl+u ' Dim data As Range Set data = Application.Selection If data.Count <> 1 Then MsgBox "Selection is too large" Exit Sub End If Selection.Copy If IsProcessRunning("Notepad.EXE") = False Then MsgBox "Notepad is down" Else Dim THandle As Long THandle = FindWindow(vbEmpty, "Test - Notepad") Dim iret As Long iret = BringWindowToTop(THandle) Call ShowWindow(THandle, SW_RESTORE) End If waittime (500) 'Call SendKeys("{F7}") Call SendKeys("^v", True) '{F12} Call SendKeys("{ENTER}") End Sub Function waittime(ByVal milliseconds As Double) Application.Wait (Now() + milliseconds / 24 / 60 / 60 / 1000) End Function Function IsProcessRunning(process As String) Dim objList As Object Set objList = GetObject("winmgmts:") _ .ExecQuery("select * from win32_process where name='" & process & "'") If objList.Count > 0 Then IsProcessRunning = True Else IsProcessRunning = False End If End Function