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.

64-bit Unsigned Integers in VBA

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

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit Python in Visual Studio Revit Stubs 2022 for Python Revit Intellisense