VBA Boost Priority Thread for Access - Win 7 and MS Server (1 Viewer)

Rx_

Nothing In Moderation
Local time
Today, 09:24
Joined
Oct 22, 2009
Messages
2,803
The BoostPriority does upgrade the Windows Priority thread on Windows 7.
Can anyone try this script on Windows Server (2003 or later) to let me know if it works there? Tell me what OS and the bits (32/64).

My environment is MS Access 2010 Front-End with DSN-Less connections to a SQL Server Back End. For developement Access runs on a desktop. For Production, MS Access runs on a dedicated virutal Windows Server and is distributed via Citrix. The application is used all over the US on both Windows and the latest Apple systems. In addition, as script runs on the serve so each user has their own personal copy of Access Front End.

The bigger reports require a lot of regulatory processing. The longer report can take 4 to 12 minutes. The acutal time is logged in a table.
Since the server is dedicated to MS Access (with some Excel automation) it makes sence to boost the priority.
Running the longer report from my Development Desktop took about 9 minutes. With the priority boost, it took a little over 2 minutes.
Note - This is probably due to bringing selected data to temp tables - then running as many as 5 cursors for regulatory situations per record. For this unique situation - the Priority Boost made a huge difference on Win 7 OS. Other reports with SQL Pass-through queries showed no difference at all. Boosting Priority is not a "one-size-fits-all" solution.

Just wondering if someone can test this on a Windows Server OS before I push this out to a production server that another group maintains.


Code:
Option Compare Database
Option Explicit
Public Sub BoostPriority()
        ' Rx_  example: substitute msaccess.exe with notpad.exe
        ' Start application, use Windows Task Manager to check before/after
          Dim strComputer As String
          Dim objWMIService As Object
          Dim colProcesses As Object
          Dim objProcess As Object
          Const ABOVE_NORMAL = 32768
          Const HIGH = 128
10        strComputer = "."
20        Set objWMIService = GetObject("winmgmts:" _
              & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
30        Set colProcesses = objWMIService.ExecQuery _
              ("Select * from Win32_Process Where Name = 'msaccess.exe'")
40        For Each objProcess In colProcesses
50            objProcess.SetPriority (ABOVE_NORMAL)
60        Next
70          Set objWMIService = Nothing
80          Set colProcesses = Nothing
90          Set objProcess = Nothing
End Sub
Public Sub GetOperatingSystemInfo(strKeyValue As String)
       ' 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
10     strComputer = "."
        ' Rx_ I have not found values for Windows 2003 Server or later
20     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
30     strWMIQuery = ":Win32_OperatingSystem.Name='" & strKeyValue & "'"
40     Set objWMIService = GetObject("winmgmts:\" & strComputer & strWMINamespace & strWMIQuery)
50     For Each objItem In objWMIService.Properties_
60         Debug.Print objItem.Name & ": " & objItem.Value
70     Next
       ' Release Memory
80     Set objItem = Nothing
90     Set colItems = Nothing
100    Set objWMIService = Nothing
End Sub
 
Last edited:

Rx_

Nothing In Moderation
Local time
Today, 09:24
Joined
Oct 22, 2009
Messages
2,803
Code appears to boost priorty from 9 Min down to 7 min on a 64 bit Windows 2008 server.

Didn't get a response all morning, so pushed this out to the production Win 2008 64 bit Server over lunch while the users were more-or-less out. Added error code at the end. A message box displaying Err.Number shows -2147217400 at the end of the BoostPriority subroutine. But, it still appeard to run much faster.

Ran the before BoostPriority was added and the time was 548 sec (9.15 miin)
Then added the PriorityBoost code - Same report ran tin 469 sec (7.75 min).
Took the PriorityBoost code out and ran exact report again immediately to make sure there was not some kind of cache thing going on. It went back up to 541 sec just like before.

Windows 2008 64bit
I don't fully understand the negative error number.
But, the report which has heavy vba cursor activity did run much faster.
The report code loggs the time stamps of differnt parts of running queries to create temp tables, the big query with cursors, and the detailed formating of an Excel Report with 10,000 rows.
The big query with cursors is what saved a big chunk of time.

So, I am going to bless it. Would welcome any comments.
 
Last edited:

Rx_

Nothing In Moderation
Local time
Today, 09:24
Joined
Oct 22, 2009
Messages
2,803
Priority class of the new process (used to determine the scheduling priorities of the
This is a cut/past from Microsoft - What were they thinking?
threads in the process). Values are:
32 - Normal
64 - Low
128 - High
16384 - Below Normal
32768 - Above Normal
 

Rx_

Nothing In Moderation
Local time
Today, 09:24
Joined
Oct 22, 2009
Messages
2,803
Followup
Got the IT staff to verify this worked on the Windows Server edition


Code:
Public Sub BoostPriority()
        ' in Main (switchboard) Form_Load call BoostPriority
        ' Verified this worked on Windows 7 and 64 bit Win Server (for Citrix distribution)
               ' Start application, use Windows Task Manager to check before/after
          Dim strComputer As String
          Dim objWMIService As Object
          Dim colProcesses As Object
          Dim objProcess As Object
          Const ABOVE_NORMAL = 32768
          Const HIGH = 128
            On Error Resume Next
10        strComputer = "."
20        Set objWMIService = GetObject("winmgmts:" _
              & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
30        Set colProcesses = objWMIService.ExecQuery _
              ("Select * from Win32_Process Where Name = 'msaccess.exe'")
40        For Each objProcess In colProcesses
50            objProcess.SetPriority (HIGH)
60        Next
            'MsgBox "Testing Please hit OK to continue", vbOKOnly, "Run Level " & Err.Number
            Err.Clear
70          Set objWMIService = Nothing
80          Set colProcesses = Nothing
90          Set objProcess = Nothing
End Sub
 

Users who are viewing this thread

Top Bottom