N
Neil
I receive the "Out of memory" message every 1 to 3 hours
of normal operation in both Access 2002 (under Win2000)
and Access 2000 (under Win98).
There are only 5 tables but I am doing some more elaborate
things with code. Here are some of things I'm doing. (I
feel that the problem must be to do with the use of form
and/or database objects that must be chewing up space and
not releasing it.)
1. Work out the last project a customer has been involved
with by interrogating all previous projects
Function LastProject(ID As Variant)
Dim strSQL As String
If Nz(ID) = "" Then
LastProject = Null
Else
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
strSQL = "SELECT tblProjectContact.IsTeam, Last
(tblProject.Start)
AS LastOfStart"
strSQL = strSQL & " FROM tblProject INNER JOIN
tblProjectContact
ON tblProject.ProjectID = tblProjectContact.ProjectID"
strSQL = strSQL & " WHERE (tblProjectContact.ContactID = "
& ID
& ")"
strSQL = strSQL & " GROUP BY tblProjectContact.IsTeam"
strSQL = strSQL & " HAVING (tblProjectContact.IsTeam =
True)"
strSQL = strSQL & " ORDER BY Last(tblProject.Start)"
strSQL = strSQL & ";"
Set rs = db.OpenRecordset(strSQL)
With rs
If .RecordCount = 0 Then
LastProject = Null
Else
LastProject = rs!LastOfStart
End If
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End If
End Function
2. Handle a form that shows the complete information of a
customer. The user double clicks on the name of the
customer and the frmcolContact form appears. If the form
is already open then the information just changes.
Sub HandlefrmcolContact(frm As Form)
If Not Application.CurrentProject.AllForms!
frmcolContact.IsLoaded Then
DoCmd.OpenForm "frmcolContact"
End If
If Not Nz(frm!ContactID) = "" Then
Forms!frmcolContact.Filter = "ContactID = " & frm!
ContactID
Forms!frmcolContact.FilterOn = True
End If
End Sub
3. Guess some default values based on previous input
Private Sub SkillID_AfterUpdate()
'Debug.Print "SkillID_AfterUpdate"
'Debug.Print "[" & Me!SkillID.OldValue & "]"
If Nz(Me!SkillID) = "" Then
Me!cmdAddSkill.Enabled = False
Else
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(ContactSQLrs(Me!SkillID))
With rs
Select Case .RecordCount
Case 0
Me!ContactID = 0
Me!cmdAddSkill.Enabled = False
Case 1
...MoveLast
Me!ContactID = !ContactID
Me!cmdAddSkill.Enabled = False
Case Else
If Nz(Me!ContactID) = "" Or Nz(Me!ContactID) = 0 Then
Else
If Not HasSkill(Me!SkillID) Then
Me!ContactID = 0
End If
End If
Me!cmdAddSkill.Enabled = True
End Select
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End If
End Sub
4. Handle the not in list event
Function HandleNotInList(ctl As Control, ObjectType As
AcObjectType,
objName, Optional fldName) As Byte
Dim bytButton As Byte
If IsMissing(fldName) Then
fldName = ""
End If
bytButton = MsgBox("Add " & ctl.Text, vbQuestion +
vbYesNo, "Add to
list")
If bytButton = vbYes Then
Select Case ObjectType
Case acTable
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(objName)
With rs
...AddNew
rs(fldName) = ctl.Text
...Update
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Case acForm
If Application.CurrentProject.AllForms!
frmcolContact.IsLoaded
Then
DoCmd.Close acForm, objName
End If
DoCmd.OpenForm objName, , , , acFormAdd, acDialog, ctl.Text
End Select
HandleNotInList = acDataErrAdded
Else
HandleNotInList = acDataErrContinue
End If
End Function
of normal operation in both Access 2002 (under Win2000)
and Access 2000 (under Win98).
There are only 5 tables but I am doing some more elaborate
things with code. Here are some of things I'm doing. (I
feel that the problem must be to do with the use of form
and/or database objects that must be chewing up space and
not releasing it.)
1. Work out the last project a customer has been involved
with by interrogating all previous projects
Function LastProject(ID As Variant)
Dim strSQL As String
If Nz(ID) = "" Then
LastProject = Null
Else
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
strSQL = "SELECT tblProjectContact.IsTeam, Last
(tblProject.Start)
AS LastOfStart"
strSQL = strSQL & " FROM tblProject INNER JOIN
tblProjectContact
ON tblProject.ProjectID = tblProjectContact.ProjectID"
strSQL = strSQL & " WHERE (tblProjectContact.ContactID = "
& ID
& ")"
strSQL = strSQL & " GROUP BY tblProjectContact.IsTeam"
strSQL = strSQL & " HAVING (tblProjectContact.IsTeam =
True)"
strSQL = strSQL & " ORDER BY Last(tblProject.Start)"
strSQL = strSQL & ";"
Set rs = db.OpenRecordset(strSQL)
With rs
If .RecordCount = 0 Then
LastProject = Null
Else
LastProject = rs!LastOfStart
End If
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End If
End Function
2. Handle a form that shows the complete information of a
customer. The user double clicks on the name of the
customer and the frmcolContact form appears. If the form
is already open then the information just changes.
Sub HandlefrmcolContact(frm As Form)
If Not Application.CurrentProject.AllForms!
frmcolContact.IsLoaded Then
DoCmd.OpenForm "frmcolContact"
End If
If Not Nz(frm!ContactID) = "" Then
Forms!frmcolContact.Filter = "ContactID = " & frm!
ContactID
Forms!frmcolContact.FilterOn = True
End If
End Sub
3. Guess some default values based on previous input
Private Sub SkillID_AfterUpdate()
'Debug.Print "SkillID_AfterUpdate"
'Debug.Print "[" & Me!SkillID.OldValue & "]"
If Nz(Me!SkillID) = "" Then
Me!cmdAddSkill.Enabled = False
Else
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(ContactSQLrs(Me!SkillID))
With rs
Select Case .RecordCount
Case 0
Me!ContactID = 0
Me!cmdAddSkill.Enabled = False
Case 1
...MoveLast
Me!ContactID = !ContactID
Me!cmdAddSkill.Enabled = False
Case Else
If Nz(Me!ContactID) = "" Or Nz(Me!ContactID) = 0 Then
Else
If Not HasSkill(Me!SkillID) Then
Me!ContactID = 0
End If
End If
Me!cmdAddSkill.Enabled = True
End Select
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End If
End Sub
4. Handle the not in list event
Function HandleNotInList(ctl As Control, ObjectType As
AcObjectType,
objName, Optional fldName) As Byte
Dim bytButton As Byte
If IsMissing(fldName) Then
fldName = ""
End If
bytButton = MsgBox("Add " & ctl.Text, vbQuestion +
vbYesNo, "Add to
list")
If bytButton = vbYes Then
Select Case ObjectType
Case acTable
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(objName)
With rs
...AddNew
rs(fldName) = ctl.Text
...Update
End With
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
Case acForm
If Application.CurrentProject.AllForms!
frmcolContact.IsLoaded
Then
DoCmd.Close acForm, objName
End If
DoCmd.OpenForm objName, , , , acFormAdd, acDialog, ctl.Text
End Select
HandleNotInList = acDataErrAdded
Else
HandleNotInList = acDataErrContinue
End If
End Function