VBA-获取任务栏应用程序

docjay 发表于 Dev

多杰

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

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

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

例子：

执行文件

EXCEL.EXE

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

例子：

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

Microsoft Excel-书1

收件箱[email protected]

VBA-获取任务栏应用程序（<-Chrome）

垃圾桶

这应该为您指明正确的方向。我能够对其进行测试，并在立即窗口（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