VBA对象销毁-内存错误 [英] VBA object destruction - memory error

查看:82
本文介绍了VBA对象销毁-内存错误的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我有一个创建的类对象,该对象具有对其他类的引用(其他任何类都不相互引用)。我遇到了一个内存问题,当我遍历并创建该类的实例时出现内存不足错误。该类和子例程的简化代码段如下:

I have an class object that I create, with references to other classes (none of the other classes reference each other). I am having a memory issue that gives the 'out of memory' error when I loop through and create instances of the class. A simplified code snippet for the class and subroutine follows:

class aclsWell

Class aclsWell

Option Explicit
Option Compare Text
Option Base 1

Private zclsSettings As bclsSettings
Private zclsInfo As bclsInfo
Private zclsProduction As bclsProduction

Private Sub Class_Initialize()
 Set zclsSettings = New bclsSettings: Set zclsSettings.Parent = Me
 Set zclsInfo = New bclsInfo: Set zclsInfo.Parent = Me
 Set zclsProduction = New bclsProduction: Set zclsProduction.Parent = Me
End Sub

Private Sub Class_Terminate()
 Set zclsSettings.Parent = Nothing: Set zclsSettings = Nothing
 Set zclsInfo.Parent = Nothing: Set zclsInfo = Nothing
 Set zclsProduction.Parent = Nothing: Set zclsProduction = Nothing
End Sub

模块:

Sub Test1()

Dim zwell As aclsWell

For i = 1 To 2000
    Set zwell = New aclsWell
    Set zWell = Nothing
Next i

End sub

在完成Test1之后,excel大约使用1 GB的数据,如果我再次运行,则会收到错误消息。但是,如果我按下VBA窗口中的停止按钮,则内存将清除。有什么方法可以模仿使用VBA按下停止按钮(例如Application.stopmacro或类似的东西)。还是我关闭对象的方式存在根本问题?非常感谢您提供任何见解。

Upon completion of the Test1, excel is using roughly 1 GB of data and if I run again, I get the error message. However, if I hit the stop button in the VBA window the memory clears. Is there any way to mimic hitting the stop button using VBA (such as Application.stopmacro or something similar). Or do I have a fundamental issue in the way I close out the objects? Many thanks for any insight.

推荐答案

当引用同时出现时,这很棘手。您将对象设置为Nothing时,引用计数不为零,因此不会触发终止事件。因此,您无法在终止事件中清理引用。

It's tricky when you have references going both ways. Your terminate event never fires because the reference count isn't zero when you set your object to Nothing. So you can't clean up your references in the terminate event.

一种选择是创建自己的终止方法。

One options is to create your own terminate method.

Public Sub Terminate()
 Set zclsSettings.Parent = Nothing: Set zclsSettings = Nothing
 Set zclsInfo.Parent = Nothing: Set zclsInfo = Nothing
 Set zclsProduction.Parent = Nothing: Set zclsProduction = Nothing

End Sub

Sub Test1()

Dim zwell As aclsWell
Dim i As Long

For i = 1 To 2000
    Set zwell = New aclsWell
    zwell.Terminate
    Set zwell = Nothing
Next i

End Sub

现在,当您单步执行代码时,将触发Class_Terminate事件因为Terminate方法将引用计数减少到零,并且VBA知道它可以清理对象。

Now when you step through the code your Class_Terminate event will fire because the Terminate method took the reference count down to zero and VBA knew it would be able to clean up the object.

我使用的方法是存储内存的位置子项中的父项,并作为Long(或64位的LongPtr)。 阅读这篇文章,尤其是Rob Bruce的评论

The method I use is to store the memory location of the parent in the child and as a Long (or LongPtr in 64 bit). Read this post and especially Rob Bruce's comment in the comments section.

' In your child class
Private m_lngParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                               (dest As Any, Source As Any, ByVal bytes As Long)

' The Parent property
Public Property Get Parent() As Class1
    Set Parent = ObjFromPtr(m_lngParentPtr)
End Property
Public Property Set Parent(obj As Class1)
    m_lngParentPtr = ObjPtr(obj)
End Property

'Returns an object given its pointer.
'This function reverses the effect of the ObjPtr function.
Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj                     As Object
    ' force the value of the pointer into the temporary object variable
    CopyMemory obj, pObj, 4
    ' assign to the result (this increments the ref counter)
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you’ll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

这篇关于VBA对象销毁-内存错误的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆