Apart from a performance question regarding ADODB recordsets, I only made one real change to your code. Since there are several fields that are output by the tasklist utility, I would want to capture all of that data just in case I need to expand my database at a later time. So I created a class called OSTask which accepts a single line from the tasklist output and parses it into its component parameters. (This means I could also skip the case you have to calculate column widths.)
Class OSTask
Option Explicit Private Type InternalData ImageName As String PID As Long SessionName As String 'could also be an Enum: Console, Services SessionNumber As Long MemUsage As Long End Type Private this As InternalData Public Property Get ImageName() As String ImageName = this.ImageName End Property Public Property Get PID() As Long PID = this.PID End Property Public Property Get SessionName() As String SessionName = this.SessionName End Property Public Property Get SessionNumber() As Long SessionNumber = this.SessionNumber End Property Public Property Get MemUsage() As Long MemUsage = this.MemUsage End Property Public Sub Init(ByVal taskData As String) '--- converts a single line output from the Windows command ' shell utility 'tasklist' and parses the data into the ' class properties Dim pos1 As Long Dim pos2 As Long '--- find the end of the task name, looking for double-space pos1 = InStr(1, taskData, " ", vbTextCompare) this.ImageName = Trim$(Left$(taskData, pos1)) '--- the next value is a number followed by a single space Dim i As Long For i = pos1 To Len(taskData) If Not Mid$(taskData, i, 1) = " " Then pos2 = InStr(i, taskData, " ", vbTextCompare) this.PID = CLng(Mid$(taskData, i, pos2 - i)) Exit For End If Next i '--- next value is the session name pos1 = pos2 + 1 pos2 = InStr(pos1, taskData, " ", vbTextCompare) this.SessionName = Trim$(Mid$(taskData, pos1, pos2 - pos1)) '--- the next value is a number followed by a single space For i = pos2 To Len(taskData) If Not Mid$(taskData, i, 1) = " " Then pos2 = InStr(i, taskData, " ", vbTextCompare) this.SessionNumber = CLng(Mid$(taskData, i, pos2 - i)) Exit For End If Next i '--- next value is the memory usage, a large number in thousands pos1 = pos2 pos2 = InStr(pos1, taskData, "K", vbTextCompare) Dim memUsageText As String memUsageText = Mid$(taskData, pos1, pos2 - pos1) memUsageText = Replace$(memUsageText, ",", vbNullString) this.MemUsage = CLng(memUsageText) * 1000 End Sub
All of the properties are read-only in this case by design.
For my example, I converted your function to return a Collection rather than an ADODB.Recordset just to make my own testing simpler. So the only real change is in the Else case of the Select statement.
For my own learning purposes, I reviewed this answer's detailed review of the command shell interactions. Since you specifically stated that you are avoiding disk I/O, the option to pipe the output to a windows temp file is no good. To really prevent the command shell pop-up, you'd have to go with running a cscript under a wscript shell as the poster there indicates. Additionally, I couldn't find any historical information that the tasklist output has changed over time, so I believe your approach should remain viable across different Windows versions.
Here is my main module with my minor edits for testing:
Option Explicit Sub test() Dim taskList As Collection Set taskList = EnumProcesses Dim task As Variant For Each task In taskList Debug.Print task.ImageName & ", " & task.MemUsage Next task End Sub Public Function EnumProcesses() As Collection Dim WshShell As IWshRuntimeLibrary.WshShell Dim WshExec As IWshRuntimeLibrary.WshExec Dim StdOut As IWshRuntimeLibrary.TextStream Dim Data As Collection Dim Output As String Dim ColumnLengths() As Long Set WshShell = CreateObject("WScript.Shell") Set WshExec = WshShell.Exec("tasklist") Set StdOut = WshExec.StdOut Set Data = New Collection Do While WshExec.Status = WshRunning If Not StdOut.AtEndOfStream Then Output = StdOut.ReadLine Select Case True Case Len(Output) = 0, _ Output Like "Image Name*" 'Skip Case Output Like "====*" 'Skip Case Else Dim thisTask As OSTask Set thisTask = New OSTask thisTask.Init Output Data.Add thisTask End Select End If Loop Set EnumProcesses = Data End Function
