Greetings,
I'm responsible for maintaining a VB6 program that is encountering "Error 7 - Out of memory" in one subroutine.
Although this application is deployed to 72 countries and runs on both XP and Win-2K servers, the problem happens only at one country, which is running Win-2K.
The subroutine loops through all tables in the master database (about 75), and exports any records that have been modified in the past 20 days into new tables in an empty database.
The failure always occurs on the same table, which is the 58th table and it is trying to export about 3,400 records. Only about 25 tables before that had any data that qualified (atotal of about 24,000 records; 8,000+ for one of those tables).
I have inserted code to check memory and disk availabilty when the subroutine starts (1.5GB disk free; % memory free = 26, total memory = 512).
One other weird item: the job runs at 7AM & 10PM. Previously the 7AM ALWAYS failed there, but I thought since the 7AM imported records we sent from HQ, maybe that was related. The 10PM ALWAYS ran with no problem (never imports) -- that is until now!
Any suggestions on changes to the code, or how to try and isolate this issue?
Thank You!
The following code has been edited to remove items not relevant to the problem.
Private Sub ExportData()
Const CURRENT_METHOD As String = CURRENT_MODULE + "ExportData"
Dim rsSrc As Recordset
Dim prmNew As Parameter
Dim SrcTbl As Table
Dim rsExport As Recordset
Dim SrcCol As Column
On Error GoTo ERROR_HANDLER
Set catLocal = New ADOX.Catalog
Set catLocal.ActiveConnection = cnLocalData
Call ADOFactory.GetConnection(DumpDatabaseFile(), cnExportData, _
adUseClient, False)
For Each SrcTbl In catLocal.Tables
If SrcTbl.Type = "TABLE" And Trim$(SrcTbl.Name) <> "ctrlKeyStorage" Then
Set rsSrc = New Recordset
rsSrc.CursorLocation = adUseClient
rsSrc.Open SrcTbl.Name, cnLocalData, adOpenForwardOnly, _
adLockReadOnly, adCmdTableDirect
If Not rsSrc.BOF And Not rsSrc.EOF Then
rsSrc.MoveFirst
sSQL = "select " & SrcTbl.Name & ".* into " & SrcTbl.Name & _
" IN '" & DumpDatabaseFile() & "' from " & SrcTbl.Name & _
" where ((([EnteredTime])>#" & vUseDate & "#));"
>>>FAILS HERE cnLocalData.Execute (sSQL) <<< FAILS HERE
DoEvents
Call ADOFactory.CloseConnection(cnExportData)
Call ADOFactory.GetConnection(DumpDatabaseFile(), cnExportData, _
adUseClient, False)
Set rsExport = New Recordset
rsExport.Open SrcTbl.Name, cnExportData, adOpenStatic, _
adLockReadOnly, adCmdTableDirect
iRecordsAffected = rsExport.RecordCount
lExport_Total = lExport_Total + iRecordsAffected
rsExport.Close
Set rsExport = Nothing
Else
' There is no data in this table! Need to provide structure!
End If
rsSrc.Close
Set rsSrc = Nothing
End If
Next SrcTbl
Write_To_Log " Total Records Exported: " & Format(lExport_Total, "###,##0")
Proc_Exit:
..
Exit Sub
ERROR_HANDLER:
‘ Journalize Error..
Resume Proc_Exit
End Sub
"Have a great day today and a better day tomorrow!
I'm responsible for maintaining a VB6 program that is encountering "Error 7 - Out of memory" in one subroutine.
Although this application is deployed to 72 countries and runs on both XP and Win-2K servers, the problem happens only at one country, which is running Win-2K.
The subroutine loops through all tables in the master database (about 75), and exports any records that have been modified in the past 20 days into new tables in an empty database.
The failure always occurs on the same table, which is the 58th table and it is trying to export about 3,400 records. Only about 25 tables before that had any data that qualified (atotal of about 24,000 records; 8,000+ for one of those tables).
I have inserted code to check memory and disk availabilty when the subroutine starts (1.5GB disk free; % memory free = 26, total memory = 512).
One other weird item: the job runs at 7AM & 10PM. Previously the 7AM ALWAYS failed there, but I thought since the 7AM imported records we sent from HQ, maybe that was related. The 10PM ALWAYS ran with no problem (never imports) -- that is until now!
Any suggestions on changes to the code, or how to try and isolate this issue?
Thank You!
The following code has been edited to remove items not relevant to the problem.
Private Sub ExportData()
Const CURRENT_METHOD As String = CURRENT_MODULE + "ExportData"
Dim rsSrc As Recordset
Dim prmNew As Parameter
Dim SrcTbl As Table
Dim rsExport As Recordset
Dim SrcCol As Column
On Error GoTo ERROR_HANDLER
Set catLocal = New ADOX.Catalog
Set catLocal.ActiveConnection = cnLocalData
Call ADOFactory.GetConnection(DumpDatabaseFile(), cnExportData, _
adUseClient, False)
For Each SrcTbl In catLocal.Tables
If SrcTbl.Type = "TABLE" And Trim$(SrcTbl.Name) <> "ctrlKeyStorage" Then
Set rsSrc = New Recordset
rsSrc.CursorLocation = adUseClient
rsSrc.Open SrcTbl.Name, cnLocalData, adOpenForwardOnly, _
adLockReadOnly, adCmdTableDirect
If Not rsSrc.BOF And Not rsSrc.EOF Then
rsSrc.MoveFirst
sSQL = "select " & SrcTbl.Name & ".* into " & SrcTbl.Name & _
" IN '" & DumpDatabaseFile() & "' from " & SrcTbl.Name & _
" where ((([EnteredTime])>#" & vUseDate & "#));"
>>>FAILS HERE cnLocalData.Execute (sSQL) <<< FAILS HERE
DoEvents
Call ADOFactory.CloseConnection(cnExportData)
Call ADOFactory.GetConnection(DumpDatabaseFile(), cnExportData, _
adUseClient, False)
Set rsExport = New Recordset
rsExport.Open SrcTbl.Name, cnExportData, adOpenStatic, _
adLockReadOnly, adCmdTableDirect
iRecordsAffected = rsExport.RecordCount
lExport_Total = lExport_Total + iRecordsAffected
rsExport.Close
Set rsExport = Nothing
Else
' There is no data in this table! Need to provide structure!
End If
rsSrc.Close
Set rsSrc = Nothing
End If
Next SrcTbl
Write_To_Log " Total Records Exported: " & Format(lExport_Total, "###,##0")
Proc_Exit:
..
Exit Sub
ERROR_HANDLER:
‘ Journalize Error..
Resume Proc_Exit
End Sub
"Have a great day today and a better day tomorrow!