VBA - 获取任务栏应用程序答案

【问题标题】：VBA - Get Taskbar ApplicationsVBA - 获取任务栏应用程序
【发布时间】：2014-08-22 04:44:54
【问题描述】：

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

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 - 获取任务栏应用程序 (

【问题讨论】：

chrome 是 64 位进程吗？（通过查看任务管理器进行验证）。
@Bathsheba 回答如下

标签： vba winapi excel

【解决方案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

【讨论】：