Link to home
Start Free TrialLog in
Avatar of Mac M
Mac MFlag 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)
Avatar of ste5an
ste5an
Flag of Germany image

Well, where do you get that error? When do you get the error? What Access version exactly?
ASKER CERTIFIED SOLUTION
Avatar of Mark Edwards
Mark Edwards
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of 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....
Avatar of 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....