Question

我在网上找到了一个代码：

Public Sub showProcesses()
    Dim W As Object
    Dim ProcessQuery As String
    Dim processes As Object
    Dim process As Object
    Set W = GetObject("winmgmts:")
    ProcessQuery = "SELECT * FROM win32_process"
    Set processes = W.execquery(ProcessQuery)
    For Each process In processes
        MsgBox process.Name
        MsgBox process.Description
    Next
    Set W = Nothing
    Set processes = Nothing
    Set process = Nothing
End Sub

它打印出所有活动进程的名称和描述。

示例：

OUTLOOK.EXE

EXCEL.EXE

但是，任务管理器中还有另一个选项卡显示应用程序（在任务栏中找到相同的选项卡）。我想创建一个读取其名字的程序。

示例：

在我的任务栏中，Chrome，Outlook和Excel是打开的应用程序，因此我希望我的程序打印出来：

Microsoft Excel - Book1

收件箱 - Somerandomemail@thisisnotreal.yzbbr

VBA - 获取任务栏应用程序（＆lt; - Chrome）

Answer 1

这应该指向正确的方向。我能够测试这个并在立即窗口（ctrl-G）中查看结果。您需要编辑才能在单元格中显示。 http://access.mvps.org/access/api/api0013.htm

更新，添加了原始作者代码的编辑版本以回答问题

Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
                "GetClassNameA" (ByVal Hwnd As Long, _
                ByVal lpClassname As String, _
                ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
                "GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
                "GetWindow" (ByVal Hwnd As Long, _
                ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
                "GetWindowLongA" (ByVal Hwnd As Long, ByVal _
                nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
                "GetWindowTextA" (ByVal Hwnd As Long, ByVal _
                lpString As String, ByVal aint As Long) As Long
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255

Function fEnumWindows()
Dim lngx As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String

    lngx = apiGetDesktopWindow()
    'Return the first child to Desktop
    lngx = apiGetWindow(lngx, mcGWCHILD)

    Do While Not lngx = 0
        strCaption = fGetCaption(lngx)
        If Len(strCaption) > 0 Then
            lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
            'enum visible windows only
            If lngStyle And mcWSVISIBLE Then
                 ActiveCell.Value = fGetCaption(lngx)
                 ActiveCell.Offset(1, 0).Activate
            End If
        End If
        lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
    Loop
End Function


Private Function fGetCaption(Hwnd As Long) As String
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
        fGetCaption = Left$(strBuffer, intCount)
    End If
End Function


Sub test()
Range("A1").Activate
 Call fEnumWindows
End Sub

VBA - 获取任务栏应用程序

1 个答案: