VBA Access: Código gernera que Access deje de responder
Cuando ejecuto este código, Access se cierra:
Option Compare Database Option Explicit Public vMemUso As String, vMemFisic As String, vMemDisp As String, vMemVirtual As String, vMemVirDisp As String, vMem As String, vSRes As String #If Depuracion Then '#If VBA7 And Win64 Then Public Declare PtrSafe Function GetSystemMetrics32 Lib "User32" _ Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Public Declare Function GetSystemMetrics32 Lib "User32" _ Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If 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 Type SYSTEM_INFO dwOemID As Long 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 '#If Depuracion Then #If VBA7 And Win64 Then Public Declare PtrSafe Sub abGlobalMemoryStatus Lib "kernel32" Alias "GlobalMemoryStatus" (lpBuffer As MEMORYSTATUS) #Else Public Declare Sub abGlobalMemoryStatus Lib "kernel32" Alias "GlobalMemoryStatus" (lpBuffer As MEMORYSTATUS) #End If Sub GetSysInfo() Dim intMousePresent As Integer Dim strBuffer As String Dim intLen As Integer Dim MS As MEMORYSTATUS Dim SI As SYSTEM_INFO 'Set the length member before you call GlobalMemoryStatus MS.dwLength = Len(MS) abGlobalMemoryStatus MS vMem = "En uso:" & MS.dwMemoryLoad & "%" & vbCrLf & _ "Física Total en uso: " & Format(Format(Fix((MS.dwTotalPhys / 1024) / 1024) / 1024), "###,###") & " Gb." & vbCrLf & _ "Física Disponible en uso: " & Format(Format((Fix(MS.dwAvailPhys / 1024) / 1024) / 1024), "###,###") & " Gb." & vbCrLf & _ "Virtual Total en uso: " & Format(Format(Fix((MS.dwTotalVirtual / 1024) / 1024) / 1024), "###,###") & " Gb." & vbCrLf & _ "Virtual Disponible en uso: " & Format(Format((Fix(MS.dwAvailVirtual / 1024) / 1024) / 1024), "###,###") & " Gb." End Sub
Con el fin de obtener información básica del equipo donde se ejecuta la Base de Datos, llamo a este código para futuro diagnóstico. Pero me deja de responder y se cierra.
¿Dónde puede estar el error? ¡Aclaro! El código no es mío.
1 respuesta
Sasha: Al hilo de mi otra contestación, no veo ese #If Depuración.
Otra fuente de Error puede estar en el Procedimiento GetSysInfo, pero la verdad es que no veo en qué sitio. Si me dices de dónde has sacado ese Código puedo mirarlo. Saludos >> Jacinto
El código lo saqué de:
http://www.mvp-access.es/buho/tematico.asp?topico=api
El texto inicial "Ejemplo Búho: Memoria Ram en un PC-> Utilizando una sencilla API," y tiene por resultado 219. Pruebo el ejemplo en Access de 64 bits y me produce el mismo resultado, Access deja de responder y se cierra.
Sasha: Sin terminar de entender el #If Depuración, lo que si yo haría es cambiar el tipo de algunas variables para trabajar en 64 y 3 bits.
Poco te va a costar con poner ésto >> Solo me refiero a las variables, ya que el resto lo veo bien sondeado.
#If VBA7 And Win64 Then Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long DwTotalPhys As LongPtr DwAvailPhys As LongPtr DwTotalPageFile As LongPtr DwAvailPageFile As LongPtr DwTotalVirtual As LongPtr DwAvailVirtual As LongPtr End Type Fichero de Texto de Office 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 #Else 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 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 wProcessorLevel As Integer wProcessorRevision As Integer End Type #End If
En el bloque de SYSTEM_INFO te he añadido alguna y creo que he cambiado algun Nombre. Ya me contarás. Saludos >> Jacinto
