VBA – 获取任务栏应用程序

我在网上find了一个代码：

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

但是，“任务pipe理器”中还有另一个显示应用程序的选项卡（与任务栏中的相同）。 我想创build一个读取他们名字的程序。

例：

在我的任务栏Chrome，Outlook和Excel是开放的应用程序，所以我想我的程序打印出来：

Microsoft Excel – Book1

收件箱 – [e-mail]

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

Answer 1

这应该指向正确的方向。 我能够testing这一点，并在即时窗口中看到结果（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