IsOffice64Bit - Determine if Microsoft Office is 64-bit

Office 2010 comes in 32-bit and 64-bit flavors. The 64-bit version requires a minimum of Windows Vista (64-bit) SP1 or Windows Server 2008 (64-bit) SP1.

The routine given below returns whether the VBA code is running under 64-bit Office or not.

Const PROCESSOR_ARCHITECTURE_AMD64 = 9

#If VBA7 Then

Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    dwPageSize As Long
    lpMinimumApplicationAddress As LongPtr
    lpMaximumApplicationAddress As LongPtr
    dwActiveProcessorMask As LongPtr
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    wProcessorLevel As Integer
    wProcessorRevision As Integer
End Type

Declare PtrSafe Sub GetSystemInfo Lib "kernel32" ( _
    lpSystemInfo As SYSTEM_INFO)

Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr
Declare PtrSafe Function IsWow64Process Lib "kernel32" ( _
    ByVal hProcess As LongPtr, _
    ByRef Wow64Process As Boolean) As Boolean

#Else

Type SYSTEM_INFO
    wProcessorArchitecture As Integer
    wReserved As Integer
    dwPageSize As Long
    lpMinimumApplicationAddress As Long
    lpMaximumApplicationAddress As Long
    dwActiveProcessorMask As Long
    dwNumberOrfProcessors As Long
    dwProcessorType As Long
    dwAllocationGranularity As Long
    dwReserved As Long
End Type

Declare Sub GetSystemInfo Lib "kernel32" ( _
    lpSystemInfo As SYSTEM_INFO)

Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function IsWow64Process Lib "kernel32" ( _
    ByVal hProcess As Long, _
    ByRef Wow64Process As Boolean) As Boolean

#End If

Function IsOffice64Bit() As Boolean
    Dim SI As SYSTEM_INFO

    IsOffice64Bit = False
    GetSystemInfo SI
    If SI.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 Then
        IsWow64Process GetCurrentProcess(), IsOffice64Bit
        IsOffice64Bit = Not IsOffice64Bit
    End If
End Function

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.