Vba 检测环境：'；大地址感知'；和3GB启动开关

VBA能否检测到/3GB引导开关

微软已经用文档记录了它，它非常好，就像MSDN页面所说的那样：他们已经解释了它是什么以及如何使用它

这个问题针对的是使用#VBA7和#Win64编译器常量的开发人员，他们对读取Excel公共工作集的API或WMI调用以及操作系统提供的内存感到满意

根本的问题是：“我是否拥有一次性执行此操作的内存”？以及“如果我将其分解，块需要多小？”

困难在于我找不到任何读取可用内存的方法来检测/3GB启动开关的存在

下面是我用来读取基本内存使用情况和可用性的代码：

Option Explicit
Option Private Module

Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long

Public Function GetMemUsage()
' Returns the current Excel.Application memory usage in MB.

' This is the 'Working Set': it counts the memory footprint
' of shared Dlls. TaskMan displays the Private Working Set.

' Charles Williams explains Excel memory limits here:
'    http://www.decisionmodels.com/memlimitsc.htm
' Microsoft have some documentation:
'     https://support.microsoft.com/en-us/help/3066990/memory-usage-in-the-32-bit-edition-of-excel-2013-and-2016

Dim objSWbemServices As Object
Set objSWbemServices = GetObject("winmgmts:") ' WMI base class


With objSWbemServices.Get("Win32_Process.Handle='" & GetCurrentProcessId & "'")

    GetMemUsage = .WorkingSetSize / 1024

End With
Set objSWbemServices = Nothing

End Function

Public Function GetMemAvailable()
' Returns the current physical RAM available


Dim objSWbemServices As Object
Set objSWbemServices = GetObject("winmgmts:") ' WMI base class
Dim obj As Object


For Each obj In objSWbemServices.InstancesOf("Win32_OperatingSystem")

    With obj

        GetMemAvailable = .FreePhysicalMemory / 1024     

    End With

Next

End Function

…差不多就这些。我没有任何看起来像“Excel几乎没有内存”的警告；在“/3GB”标志上没有任何线索。

请参阅我在LAA上的博客文章

你可以下载我的LAA内存检查工具，它有所有的Windows API调用来检查Excel的可用内存

代码：

'
' COPYRIGHT © DECISION MODELS LIMITED 2016. All rights reserved
'
' Charles Williams 27 November 2016
'
Option Explicit
'
' WinApi declarations
'
#If VBA7 Then
    '
    Private Declare PtrSafe Function GlobalMemoryStatusEx Lib "Kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    '
    '
    ' os version info
    '
    Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128                      '  Maintenance string for PSS usage
End Type

' dwPlatforID Constants
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
#Else
    '
    Private Declare Function GlobalMemoryStatusEx Lib "Kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As Long
    Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    ' os version info
    '
    Public Declare Function GetVersionEx Lib "kernel32" Alias _
                                         "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128                      '  Maintenance string for PSS usage
End Type

' dwPlatforID Constants
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

#End If
'
'API Structures for status of memory
'
Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type

Private Type MEMORYSTATUSEX
    dwLength As Long
    dwMemoryLoad As Long
    ullTotalPhys As LARGE_INTEGER
    ullAvailPhys As LARGE_INTEGER
    ullTotalPageFile As LARGE_INTEGER
    ullAvailPageFile As LARGE_INTEGER
    ullTotalVirtual As LARGE_INTEGER
    ullAvailVirtual As LARGE_INTEGER
    ullAvailExtendedVirtual As LARGE_INTEGER
End Type
Sub ShowExcelMemory()
'
' Find used and available Excel Virtual Mmory
'
    Dim MemStat As MEMORYSTATUSEX
    Dim dTotalVirt As Currency
    Dim dAvailVirt As Currency
    Dim dUsedVirt As Currency
    Dim lMB As Currency
    Dim strWindows As String
    Dim XL64 As String
    Dim jXLVersion As Long
    Dim nMajorVersion As Long
    Dim nBuildNumber As Long
    '
    lMB = 1048576
    '
    ' Windows version, build and bitness
    '
    strWindows = " 32 bit"
    If Len(Environ("PROGRAMFILES(x86)")) <> 0 Then strWindows = " 64 bit"
    strWindows = strWinVersion2(nMajorVersion, nBuildNumber) & " Build " & nBuildNumber & strWindows
    '
    ' Excel version, build and bitness
    '
    jXLVersion = Val(Application.Version)
    #If Win64 Then
        XL64 = strXLVersion(jXLVersion) & " Build " & CStr(Application.Build) & "64 bit"
    #Else
        XL64 = strXLVersion(jXLVersion) & " Build " & CStr(Application.Build) & " 32 bit"
    #End If
    '
    ' virtual memory used and maximum available
    '
    MemStat.dwLength = Len(MemStat)
    GlobalMemoryStatusEx MemStat
    '
    dTotalVirt = LargeIntToCurrency(MemStat.ullTotalVirtual) / lMB
    dAvailVirt = LargeIntToCurrency(MemStat.ullAvailVirtual) / lMB
    dUsedVirt = Round((dTotalVirt - dAvailVirt) / 1024, 2)
    dTotalVirt = Round(dTotalVirt / 1024, 2)
    '
    MsgBox strWindows & vbCrLf & XL64 & vbCrLf & vbCrLf & "Currently using " & CStr(dUsedVirt) & " GB of Virtual Memory" & vbCrLf & "Maximum Available is " & CStr(dTotalVirt) & " GB Virtual Memory", vbOKOnly + vbInformation, "Excel Virtual Memory Usage"
End Sub

Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
'copy 8 bytes from the large integer to an empty currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    'adjust it
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function
Function strWinVersion2(nMajorVersion As Long, nBuildNumber As Long) As _
         String
'
' Function to return the OS Version
'
    Dim tOSVer As OSVERSIONINFO
    Dim strSP As String

    ' First set length of OSVERSIONINFO
    ' structure size
    tOSVer.dwOSVersionInfoSize = Len(tOSVer)
    ' Get version information
    GetVersionEx tOSVer
    ' Determine OS type
    With tOSVer

        If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
            ' This is an NT version (NT/2000/XP)

            If .dwMajorVersion = 5 Then
                Select Case .dwMinorVersion
                Case 0
                    strWinVersion2 = "Windows 2000 "
                Case 1
                    strWinVersion2 = "Windows XP "
                Case 2
                    strWinVersion2 = "Windows 2003 "
                Case Else
                    strWinVersion2 = "Windows NT " & .dwMajorVersion & "." & _
                                     .dwMinorVersion & " "
                End Select
            ElseIf .dwMajorVersion = 6 Then
                Select Case .dwMinorVersion
                Case 0
                    strWinVersion2 = "Windows Vista "
                Case 1
                    strWinVersion2 = "Windows 7 "
                Case 2
                    strWinVersion2 = "Windows 8 "
                Case Else
                    strWinVersion2 = "Windows 10 "
                End Select
            ElseIf .dwMajorVersion = 10 Then
                strWinVersion2 = "Windows 10 "
            Else
                strWinVersion2 = "Windows 10 "
            End If
        Else
            ' This is Windows 95/98/ME
            If .dwMajorVersion >= 5 Then
                strWinVersion2 = "Windows ME "
            ElseIf .dwMajorVersion = 4 And .dwMinorVersion > 0 Then
                strWinVersion2 = "Windows 98 "
            Else
                strWinVersion2 = "Windows 95 "
            End If
        End If
        nMajorVersion = .dwMajorVersion
        nBuildNumber = .dwBuildNumber
        'strSP = .szCSDVersion
        If Len(strSP) > 0 Then strWinVersion2 = strWinVersion2 & strSP
    End With
GoExit:
End Function
Function strXLVersion(jXLVersion As Long) As String
'
' convert the Excel version number to a string
'
    Select Case jXLVersion
    Case 8
        strXLVersion = "Excel 97"
    Case 9
        strXLVersion = "Excel 2000"
    Case 10
        strXLVersion = "Excel 2002"
    Case 11
        strXLVersion = "Excel 2003"
    Case 12
        strXLVersion = "Excel 2007"
    Case 14
        strXLVersion = "Excel 2010"
    Case 15
        strXLVersion = "Excel 2013"
    Case 16
        strXLVersion = "Excel 2016"
    Case Else
        strXLVersion = "Excel 20??"
    End Select

End Function

'
“版权所有©决策模型有限公司2016年。版权所有
'
查尔斯·威廉姆斯2016年11月27日
'
选项显式
'
'WinApi声明
'
#如果是VBA7，则
'
私有将PtrSafe函数GlobalMemoryStatusEx Lib“Kernel32.dll”（ByRef lpBuffer作为MEMORYSTATUSEX）声明为LongPtr
Private Declare PtrSafe Sub CopyMemory Lib“Kernel32.dll”别名“rtlmovemory”（目标为任意，源为任意，ByVal长度为LongPtr）
'
'
'操作系统版本信息
'
将PtrSafe函数GetVersionEx Lib“kernel32”别名“GetVersionExA”（lpVersionInformation作为OSVERSIONINFO）声明为
公共类型OSVERSIONINFO
dwOSVersionInfoSize尽可能长
dwMajorVersion尽可能长
只要
dwBuildNumber尽可能长
长的扁平状的
SZCSD版本为字符串*128'维护字符串，用于PSS使用
端型
'dwPlatforID常量
私有Const VER_PLATFORM_WIN32s=0
私有常量版本平台WIN32 WINDOWS=1
私有常量版本平台WIN32 NT=2
#否则
'
私有声明函数GlobalMemoryStatusEx Lib“Kernel32.dll”（ByRef lpBuffer作为MEMORYSTATUSEX）的长度为
私有声明子CopyMemory库“Kernel32.dll”别名“RtlMoveMemory”（目标为任意，源为任意，ByVal长度为任意）
'操作系统版本信息
'
公共声明函数GetVersionEx Lib“kernel32”别名_
“GetVersionExA”（lpVersionInformation作为OSVERSIONINFO）的长度
公共类型OSVERSIONINFO
dwOSVersionInfoSize尽可能长
dwMajorVersion尽可能长
只要
dwBuildNumber尽可能长
长的扁平状的
SZCSD版本为字符串*128'维护字符串，用于PSS使用
端型
'dwPlatforID常量
私有Const VER_PLATFORM_WIN32s=0
私有常量版本平台WIN32 WINDOWS=1
私有常量版本平台WIN32 NT=2
#如果结束
'
'内存状态的API结构
'
私有类型大整数
低部分一样长
长的部分
端型
私有类型MemoryStatutex
长度等于
只要
ullTotalPhys作为大整数
ullAvailPhys作为大整数
ullTotalPageFile为大整数
ullAvailPageFile为大整数
ulltottalvirtual作为大整数
ullAvailVirtual为大整数
ullAvailablextendedVirtual为大整数
端型
子内存（）
'
'查找已使用和可用的Excel虚拟内存
'
作为MemoryStatutex的Dim MemStat
作为货币的Dim dTotalVirt
Dim dAvailVirt作为货币
Dim dUsedVirt作为货币
作为货币的Dim lMB
作为字符串的Dim strWindows
Dim XL64作为字符串
将jxl版本变长
暗版与长版相同
数字越长越好
'
lMB=1048576
'
'Windows版本、内部版本和bitness
'
strWindows=“32位”
如果Len（Environ（“PROGRAMFILES（x86）”）为0，则strWindows=“64位”
strWindows=strwininversion2（nMajorVersion，nBuildNumber）&“Build”&nBuildNumber&strWindows
'
'Excel版本、内部版本和bitness
'
jXLVersion=Val（Application.Version）
#如果是Win64，那么
XL64=strXLVersion（jXLVersion）和“Build”以及CStr（Application.Build）和“64位”
#否则
XL64=strXLVersion（jXLVersion）和“Build”以及CStr（Application.Build）和“32位”
#如果结束
'
'已使用虚拟内存和最大可用内存
'
MemStat.dwLength=Len（MemStat）
GlobalMemoryStatusEx MemStat
'
dTotalVirt=大电流（MemStat.ullTotalVirtual）/lMB
dAvailVirt=大电流（MemStat.ullAvailVirtual）/lMB
dUsedVirt=Round（（dTotalVirt-dAvailVirt）/1024，2）
dTotalVirt=圆形（dTotalVirt/1024，2）
'
MsgBox strWindows&vbCrLf&XL64&vbCrLf&vbCrLf&“当前使用”&CStr（dUsedVirt）和“GB虚拟内存”&vbCrLf&“最大可用空间”&CStr（dTotalVirt）和“GB虚拟内存”，vbOKOnly+vb信息，“Excel虚拟内存使用情况”
端接头
私有函数LargeIntToCurrency（liInput作为大整数）作为货币
'将8字节从大整数复制到空货币
CopyMemory大电流，liInput，LenB（liInput）
“调整一下
大电流=大电流*10000
端函数
函数strWinVersion2（nMajorVersion尽可能长，nBuildNumber尽可能长）为_
一串
'
'函数返回操作系统版本
'
Dim Tover作为OSVERSIONINFO
作为字符串的Dim strSP
'OSVERSIONINFO的第一个设置长度
“结构尺寸
tOSVer.dwosVersionInfo=Len（tOSVer）
'获取版本信息
GetVersionEx tOSVer
'确定操作系统类型
翻来覆去
如果.dwPlatformId=VER\u PLATFORM\u WIN32\n则
'这是一个NT版本（NT/2000/XP）
如果.dwMajorVersion=5，则
选择Case.dwMinorVersion