Set High Priority to a process from VBA in Windows

SystemPriority.bas

Public Sub setPriority(processName as String)

    Const IDLE = 64
    Const BELOW_NORMAL = 16384
    Const NORMAL = 32
    Const ABOVE_NORMAL = 32768
    Const HIGH = 128
    Const REALTIME = 256
    Dim strComputer As String
    Dim objWMIService As Object
    Dim colProcesses As Object
    Dim objProcess As Object

    errorPosition = "system.setPriority"
    On Error GoTo errorTrap
    Err.clear
    
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
                                & "{impersonationLevel=impersonate}!\\" _
                                & strComputer & "\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery _
      ("Select * from Win32_Process Where Name = '" & processName & "'")
    For Each objProcess In colProcesses
        objProcess.setPriority (HIGH)
    Next
    
    LogDiagnosticsMessage "Set application to high system priority"
    
    GoTo cleanExit
    
cleanExit:
    On Error Resume Next
    
    Set objWMIService = Nothing
    Set colProcesses = Nothing
    Set objProcess = Nothing
    
    Exit Sub

errorTrap:
    LogDiagnosticsMessage Right(ThisDisplay.FullName, Len(ThisDisplay.FullName) - 3) & ", Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], Description: " & Err.Description & ""
    Resume cleanExit
End Sub


Public Sub GetOperatingSystemInfo(strKeyValue As String) 'not used
    ' We are using late binding
    Dim objWMIService As Object
    Dim colItems As Object
    Dim objItem As Object
    Dim strWMINamespace As String
    Dim strComputer As String
    Dim strWMIQuery As String
    
    errorPosition = "system.GetOperatingSystemInfo"
    On Error GoTo errorTrap
    Err.clear
    
    strComputer = "."
    ' Rx_ I have not found values for Windows 2003 Server or later
    strWMINamespace = "\root\cimv2"
    ' Use strKeyValue to specify the value of the Key Property to get the "instance"
    ' of the Win32_OperatingSystem Class in order to get the Property Values
    strWMIQuery = ":Win32_OperatingSystem.Name='" & strKeyValue & "'"
    Set objWMIService = GetObject("winmgmts:\" & strComputer & strWMINamespace & strWMIQuery)
    For Each objItem In objWMIService.Properties_
        LogDiagnosticsMessage objItem.Name & ": " & objItem.value
    Next
    ' Release Memory

    
    GoTo cleanExit
    
cleanExit:
    On Error Resume Next
    
    Set objItem = Nothing
    Set colItems = Nothing
    Set objWMIService = Nothing
    
    Exit Sub

errorTrap:
    LogDiagnosticsMessage Right(ThisDisplay.FullName, Len(ThisDisplay.FullName) - 3) & ", Position: " & errorPosition & " , Error Code: [ " & Hex(Err.number) & "], Description: " & Err.Description & ""
    Resume cleanExit
End Sub