64-bit Unsigned Integers in VBA
There is no native 64-bit unsigned integer data type in VBA. In practice, this is rarely an issue. But "rarely" is not the same as "never." To take advantage of certain Windows API calls, you'll need a workaround.
Option Compare Database
Option Explicit
'Inspired by: https://stackoverflow.com/a/48626253/154439 (h/t Charles Williams)
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
#End If
#If Win64 Then
Declare PtrSafe Sub GlobalMemoryStatusEx Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
'GlobalMemoryStatusEx outputs memory sizes in 64-bit *un*-signed integers;
' LongLong won't give us correct values because it is a signed type;
' the workaround is to use a custom data type and convert the result to Currency,
' as Currency is a fixed-point numeric data type supporting large values
Public Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As LARGE_INTEGER
dwAvailPhys As LARGE_INTEGER
dwTotalPageFile As LARGE_INTEGER
dwAvailPageFile As LARGE_INTEGER
dwTotalVirtual As LARGE_INTEGER
dwAvailVirtual As LARGE_INTEGER
dwAvailExtendedVirtual As LARGE_INTEGER
End Type
#Else
Declare PtrSafe Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Public Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
#End If
'Convert raw 64-bit unsigned integers to Currency data type
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
Sub ShowMemStats()
Dim Mem As MEMORYSTATUS
Mem.dwLength = LenB(Mem)
#If Win64 Then
GlobalMemoryStatusEx Mem
#Else
GlobalMemoryStatus Mem
#End If
Debug.Print "Memory load:", , Mem.dwMemoryLoad; "%"
Debug.Print
Debug.Print "Total physical memory:", BytesToXB(Mem.dwTotalPhys)
Debug.Print "Physical memory free: ", BytesToXB(Mem.dwAvailPhys)
Debug.Print
Debug.Print "Total paging file:", BytesToXB(Mem.dwTotalPageFile)
Debug.Print "Paging file free: ", BytesToXB(Mem.dwAvailPageFile)
Debug.Print
Debug.Print "Total virtual memory:", BytesToXB(Mem.dwTotalVirtual)
Debug.Print "Virtual memory free: ", BytesToXB(Mem.dwAvailVirtual)
End Sub
'Convert raw byte count to a more human readable format
#If Win64 Then
Private Function BytesToXB(RawValue As LARGE_INTEGER) As String
Dim Value As Currency
Value = LargeIntToCurrency(RawValue)
#Else
Private Function BytesToXB(Value As Long) As String
#End If
Select Case Value
Case Is > (2 ^ 30)
BytesToXB = Round(Value / (2 ^ 30), 2) & " GB"
Case Is > (2 ^ 20)
BytesToXB = Round(Value / (2 ^ 20), 2) & " MB"
Case Is > (2 ^ 10)
BytesToXB = Round(Value / (2 ^ 10), 2) & " KB"
Case Else
BytesToXB = Value & " B"
End Select
End Function
Comments
Post a Comment