troubleshooting Question

Access VBA Question

Avatar of Mac M
Mac MFlag for United States of America asked on
Windows 10Microsoft OfficeDatabasesWindows OSVBA
4 Comments1 Solution156 ViewsLast Modified:
How can I make this run in Windows 10 64bit, my users are receiving the System Exceed Resources for Access 2016???....The below worked for Windows 7 32bit but I'm unsure what need to be changed for 64bit.....

Option Compare Database
Option Explicit

' Code adapted from post by Dennis Wi in reply to "Access 2010 Compact & Repair drops indexes" post
' on Microsoft Office for Developers forums > Access for Developers forum
' http://social.msdn.microsoft.com/Forums/office/en-US/b188f2fe-8f5d-4a7b-b5f8-bc4c26854164/access-2010-compact-repair-drops-indexes?forum=accessdev

Declare Function GetProcessAffinityMask Lib "kernel32.dll" (ByVal hProcess As Long, ByRef dwProcessAffinityMask As Long, ByRef dwSystemAffinityMask As Long) As Boolean

Declare Function SetProcessAffinityMask Lib "kernel32.dll" (ByVal hProcess As Long, ByVal dwProcessAffinityMask As Long) As Boolean

Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Type SYSTEM_INFO
' http://www.java2s.com/Code/VBA-Excel-Access-Word/Windows-API/GettheProcessortypeandnumberofprocessors.htm

    dwOemID As Long
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long

End Type ' SYSTEM_INFO

Public Function SetAffinity()
' Set processor affinity for this instance of MSACCESS.EXE.
' Useful for limiting Access to 4 CPUs on multicore Windows 7 computers
' to avoid "System resource exceeded" errors.

' Code adapted from post by Dennis Wi in reply to "Access 2010 Compact & Repair drops indexes" post
' on Microsoft Office for Developers forums > Access for Developers forum
' http://social.msdn.microsoft.com/Forums/office/en-US/b188f2fe-8f5d-4a7b-b5f8-bc4c26854164/access-2010-compact-repair-drops-indexes?forum=accessdev
On Error GoTo NecErrHnd

Dim PrintMe As String: PrintMe = "SetAffinity": Debug.Print PrintMe

    Dim TriggerNumProcessors As Integer, MaxAffinityMask As Integer
    TriggerNumProcessors = 4
    MaxAffinityMask = (2 ^ TriggerNumProcessors) - 1

    ' Only change affinity if computer has more than 4 cores.
    If GetNumProcessors > TriggerNumProcessors Then
        Dim hRet As Long
        Dim dwProcMask As Long
        Dim dwSysMask As Long

        hRet = GetProcessAffinityMask(GetCurrentProcess(), dwProcMask, dwSysMask)

        If dwProcMask > MaxAffinityMask Then
            ' Set affinity to the required number of processors.
            hRet = SetProcessAffinityMask(GetCurrentProcess(), MaxAffinityMask)
ASKER CERTIFIED SOLUTION
Mark Edwards
Chief Technology Officer

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 4 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros