Simplified a little;
This in a Form having one Command Button and a List Box
Option Explicit
Private Sub Command1_Click()
Dim ArrayOfAppPaths As Variant, i As Integer
ListAppsRunning ArrayOfAppPaths
List1.Clear
For i = 1 To UBound(ArrayOfAppPaths)
List1.AddItem ArrayOfAppPaths(i)
Next
End Sub
This in a module;
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleFileNameEx Lib "psapi" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Sub CloseHandle Lib "kernel32" (ByVal hObject As Long)
Private Const TH32CS_SNAPPROCESS = 2&
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const PROCESS_VM_READ = &H10&
Private Const MAX_PATH = 260&
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Public Sub ListAppsRunning(ArrayOfAppNames As Variant)
ReDim ArrayOfAppNames(0)
'Dimmed from 0 however the first entry(if found) will be in ArrayOfAppNames(1)
Dim pe32 As PROCESSENTRY32
Dim hSnapShot As Long
Const OsVersion = 4 'Replace this Constant with a Function which returns the OS version 4=Win2000
If OsVersion < 4# Then
'cannot be determined unless Windows 2000 or later is in use
Else
'Enumerate processes
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, ByVal 0)
pe32.dwSize = Len(pe32)
ProcessFirst hSnapShot, pe32
Do
ReDim Preserve ArrayOfAppNames(UBound(ArrayOfAppNames) + 1)
ArrayOfAppNames(UBound(ArrayOfAppNames)) = GetPathFromPid(pe32.th32ProcessID)
Loop While ProcessNext(hSnapShot, pe32)
CloseHandle hSnapShot
End If
End Sub
'returns the full path of a process identified by Pid.
Private Function GetPathFromPid(ByVal Pid As Long) As String
Dim hProcess As Long, s As String * MAX_PATH
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, Pid)
GetModuleFileNameEx hProcess, 0, s, MAX_PATH 'this call crashes under Win 95, 98 and probably NT4 and ME
CloseHandle hProcess
GetPathFromPid = Left$(s, InStr(s, vbNullChar) - 1)
End Function
