Avatar of Mac M
Mac M
Flag for United States of America asked on

Access VBA Question

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)
Windows 10Microsoft OfficeDatabasesWindows OSVBA

Avatar of undefined
Last Comment
Mac M

8/22/2022 - Mon
ste5an

Well, where do you get that error? When do you get the error? What Access version exactly?
ASKER CERTIFIED SOLUTION
Mark Edwards

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Mac M

ASKER
Thanks Mark,

I'm still learning the VB language and how to decipher it's many acronyms...You solution was what I needed in order to run the code in Access 2016....
Mac M

ASKER
Thanks Mark,

I'm still learning the VB language and how to decipher it's many acronyms...You solution was what I needed in order to run the code in Access 2016....
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck