Memory Leak

[richaa]

I am having problems with memory. I have a program that runs continuously. A timer initiates the database updates every 5 seconds while it is not alreay processing records. If I run this program on a NT and watch the memory usage from the task manager, each time it processes the updates to the database more memory is used and is never released. Eventually the program errors and all the available memory is used. When I commented out the database manipulation section, there is no problem with memory. Below is a piece of code that is causing the problem. I do not see the problem. Could anyone please help me?

Public Sub DoClaimant()
'data from Spectrasoft Appointments are 'being added to the appropriate fields in 'the claimant table in the HMT database
Dim stSql As String
Dim stDate As String
Dim stPhone As String
Dim bValid As Boolean
Dim gSQLClaimantFields As String
Dim gSQLEmployerFields As String

On Error GoTo ErrorHandler
'check for minimal information for the
'claimant
bValid = ValidateClaimant

If bValid Then
Set rsClaimant = New ADODB.Recordset
gSQLClaimantFields = "claimant_id,ssn,lastname,firstname,mi,address,city,state,zip,homephone,workphone,recdate,dateofbirt h,sex,employer_name,employer_id"
'select based on the social security
'number
stSql = "SELECT " & gSQLClaimantFields & " FROM claimant WHERE SSN= '" & PatientID & "'"
With rsClaimant
.CursorLocation = adUseClient
.Open stSql, Conn,
adOpenForwardOnly,
adLockBatchOptimistic, adCmdText
End With

DoEvents

'if a record doesn't already exist,
'add one
If rsClaimant.EOF = True Then
rsClaimant.AddNew
End If

'set the fields
If IsNull(PatientID) = False Then
rsClaimant.Fields("SSN").Value =
PatientID
End If
rsClaimant.Fields("recdate").Value =
CDate(Format(Date, "mm/dd/yyyy"))
If IsNull(PatientLname) = False Then
rsClaimant.Fields("LastName").Value
= SetLength(25, PatientLname)
End If
If IsNull(PatientFname) = False Then
rsClaimant.Fields("FirstName").Value
= SetLength(14, PatientFname)
End If
If IsNull(PatientMI) = False Then
rsClaimant.Fields("MI").Value =
SetLength(1, PatientMI)
End If
If IsNull(PatientStreet) = False Then
rsClaimant.Fields("Address").Value
= SetLength(30, PatientStreet)
End If
If IsNull(Patientstate) = False Then
rsClaimant.Fields("state").Value
= SetLength(2, Patientstate)
End If
If IsNull(PatientCity) = False Then
rsClaimant.Fields("city").Value =
SetLength(20, PatientCity)
End If
If IsNull(Patientzip) = False Then
rsClaimant.Fields("Zip").Value =
Patientzip
End If
If IsNull(Patientbdate) = False Then
'must format SpectraSoft not Y2K
'compliant
stDate = FormatDate(Patientbdate)
If Len(stDate) <> 0 Then
rsClaimant.Fields
("dateofbirth").Value = CDate
(stDate)
End If
End If
If IsNull(PatientSex) = False Then
If PatientSex = "M" Or
PatientSex = "Male" Then
rsClaimant.Fields("sex").Value
= "Male"
ElseIf PatientSex = "F" Or
PatientSex = "Female" Then
rsClaimant.Fields("sex").Value
= "Female"
End If
End If
If IsNull(PatientHphone) = False Then
stPhone = FormatPhone(PatientHphone)
If Len(stPhone) <> 0 Then
rsClaimant.Fields
("homephone").Value = stPhone
End If
End If
DoEvents
'need the employer info to finish the
'claimant
'so jump over to DoEmployer then come
'back
'and set the fields we need from it
Call DoEmployer
Set rsEmployer = New ADODB.Recordset
gSQLEmployerFields =
"employer_id,employer_name,phone"
If IsNull(FRPPhoneNbr) = False Then
stPhone = FormatPhone(FRPPhoneNbr)
If Len(stPhone) <> 0 Then
'this select is prefered but
'if the phone
'is invalid, select with just
'the name
stSql = "SELECT " & gSQLEmployerFields & " FROM Employer where employer_name= '" & SetLength(40, FRPName) & "'" & " and phone= '" & stPhone & "'"
Else
stSql = "SELECT " & gSQLEmployerFields & " FROM Employer where employer_name= '" & SetLength(40, FRPName) & "'"
End If
Else
'if the phone is null, select with
'just the name
stSql = "SELECT " & gSQLEmployerFields & " FROM Employer where employer_name= '" & SetLength(40, FRPName) & "'"
End If
With rsEmployer
.CursorLocation = adUseClient
.Open stSql, Conn, adOpenForwardOnly, adLockBatchOptimistic, adCmdText
End With
DoEvents
If rsEmployer.EOF = False Then
If IsNull(rsEmployer.Fields("Employer_ID").Value) = False Then
rsClaimant.Fields("employer_ID").Value = rsEmployer.Fields("Employer_ID").Value
End If
End If

'finished with employer so close the
'recordset
rsEmployer.Close
Set rsEmployer = Nothing

If IsNull(PatientWPhone) = False Then
stPhone = FormatPhone(PatientWPhone)
If Len(stPhone) <> 0 Then
rsClaimant.Fields("workphone").Value = stPhone
End If
End If
If IsNull(FRPName) = False Then
rsClaimant.Fields("employer_name").Value = SetLength(30, FRPName)
End If

'finished setting fields, update and
'close the recordset
rsClaimant.Update
rsClaimant.Close
DoEvents
Set rsClaimant = Nothing
End If
DoEvents
Exit Sub

ErrorHandler:
MsgBox "Error in DoClaimant=" &
Err.Number & ", " & Err.Description
rsClaimant.CancelUpdate
rsClaimant.Close
Call HandleError
End Sub

[WadeD]

Looks clean to me, as you're setting any recordsets that you open to nothing. You should probably add that to your error-handling, though. Have you tried commenting out small pieces instead of the entire segment to see if you can isolate the problem better?