Question

目标

拥有一个包含＆＃34;搜索＆＃34;的Excel文件用于打开自定义程序的按钮。该程序用于研究。如果程序在用户单击按钮时已打开，请将其弹出并专注于该给定程序。

现状

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

搜索按钮

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

此代码仅在我放置＆＃34; Word.Application＆＃34;作为可执行文件。如果我尝试将＆＃34; MyProgram.Application＆＃34;该函数永远不会看到程序正在运行。我怎样才能找到＆＃34; MyProgram.exe＆＃34;目前正在开放？

此外，我需要把重点放在它上面......

Answer 1

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

这将根据进程名称进行搜索，并在适当时返回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

以下是我将搜索窗口置于前面的方式：

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

现在，如果窗口已最小化并且用户再次单击搜索按钮，则会弹出窗口。

Answer 3

仅需指出，当在应用程序实例中打开文档时，窗口文本可能会更改。

例如，我试图让CorelDRAW成为焦点，只要在Corel中没有打开任何文档，一切都会很好，如果有的话，我需要将全名传递给FindWindow()包括打开的文档。

所以，不仅仅是：

FindWindow("CorelDRAW 2020 (64-Bit)")

必须是：

FindWindow("CorelDRAW 2020 (64-Bit) - C:\CompletePath\FileName.cdr")

这就是从GetWindowText()返回的内容

显然这是一个问题，因为您不知道用户将在应用程序中打开什么文档，所以对于多年以后可能会来这里的其他任何人，可能遇到相同问题的这是我所做的

Option Explicit
Private Module

Private Const EXE_NAME As String = "CorelDRW.exe"
Private Const WINDOW_TEXT As String = "CorelDRAW 2020" ' This is common with all opened documents

Private Const GW_HWNDNEXT = 2
Private Const SW_RESTORE = 9

Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Sub FocusIfRunning(parAppName as String, parWindowText as String)

    Dim oProcs As Object
    Dim lWindowHandle As Long
    Dim sWindowText As String
    Dim sBuffer As String

    ' Create WMI object and execute a WQL query statement to find if your application
    ' is a running process. The query will return an SWbemObjectSet.

    Set oProcs = GetObject("winmgmts:").ExecQuery("SELECT * FROM win32_process WHERE " & _
                            "name = '" & parAppName & "'")

    ' The Count property of the SWbemObjectSet will be > 0 if there were
    ' matches to your query.

    If oProcs.Count > 0 Then

        ' Go through all the handles checking if the start of the GetWindowText()
        ' result matches your WindowText pre-file name.
        ' GetWindowText() needs a buffer, that's what the Space(255) is.

        lWindowHandle = FindWindow(vbEmpty, vbEmpty)

        Do While lWindowHandle

            sBuffer = Space(255)
            sWindowText = Left(sBuffer, GetWindowText(lWindowHandle, sBuffer, 255))

            If Mid(sWindowText, 1, Len(parWindowText)) Like parWindowText Then Exit Do

            ' Get the next handle. Will return 0 when there are no more.

            lWindowHandle = GetWindow(lWindowHandle, GW_HWNDNEXT)

        Loop

        Call ShowWindow(lWindowHandle , SW_RESTORE)

    End If

End Sub

Private Sub btnFocusWindow_Click()
    Call FocusIfRunning(EXE_NAME, WINDOW_TEXT)
End Sub

希望有人从中得到利用，而不必花时间去做。

Answer 4

只是想说谢谢你的解决方案。只是刚刚开始玩代码并希望自动完成我的工作。此代码只需单击即可将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

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

目标

现状

4 个答案: