Out of memory when running module

jamesmor

Registered User.
Local time
Yesterday, 22:25
Joined
Sep 8, 2004
Messages
126
I have a module that takes a DB, separates out individual reps' accounts and sends it to them. now it works ok, but after like every 6th set of accounts that gets sent out I get an out of memory message, there's 50 or so reps I need to do this with each rep has between 0 and 2000 accounts, and must restart my computer before I can run anything in access. I can't see anything wrong with the code and was wondering if someone here could help.

Option Compare Database
Option Explicit

'------------------------------------------------------------
' Split and send of rep accounts
'
'This program will split and send all rep accounts
'then call another function to split and send team accounts
'
'Created - 9/21/04 - Nathan Morton
'Nathan.Morton@infousa.com
'------------------------------------------------------------
Function Rep_Split_And_Send()
On Error GoTo Orders_Err

Dim db As Database 'declaring db
Dim rst As DAO.Recordset 'declaring recordset
Dim rstRep As DAO.Recordset 'declaring recordset
Dim strRep As String 'declaring variables
Dim strEMail As String 'declaring variables
Dim strRepName As String 'declaring variables
Dim qryDef As DAO.QueryDef 'declaring query

Set db = CurrentDb

Set rstRep = db.OpenRecordset("SELECT DISTINCT Active_Customers_Final.RepEmail, Active_Customers_Final.Billing_Name FROM Active_Customers_Final;", dbOpenDynaset)

On Error Resume Next
DoCmd.DeleteObject acQuery, "ActiveCustomers"
On Error GoTo Orders_Err

With rstRep
Do While Not .EOF
strRep = .Fields(0)
'MsgBox (strRep) - This is used to test what rep name we are getting - for email
strRepName = .Fields(1)
'MsgBox ("repname" & strRepName) - used to test what rep name we are getting for spreadsheet.
strEMail = strRep & "@infousa.com"
'MsgBox (strEMail) - testing final email address

'below code actuaclly creates the temporary query, splits the accounts, send the reps their accounts via email and transfers a spreadsheet to a specified location.
Set qryDef = db.CreateQueryDef("ActiveCustomers", "SELECT Account, First_Name, Last_Name, Company, Address, City, State, Zip, Phone, Email, Registration_Date, Number_of_Orders, Total_Revenue, Last_Order_Date, Last_Activity_Date, Activity_Notes FROM Active_Customers_Final WHERE Active_Customers_Final.RepEmail = """ & strRep & """ ")
DoCmd.SendObject acSendQuery, "ActiveCustomers", "Microsoft Excel (*.xls)", strEMail, "", "", "Monthly Orders", "Here are your active customers from AMU", False, ""
DoCmd.TransferSpreadsheet acExport, 8, "ActiveCustomers", "C:\Documents and Settings\NathanM\Desktop\Dan\" & strRepName, True, ""
DoCmd.DeleteObject acQuery, "ActiveCustomers"
.MoveNext
Loop
End With

Set db = Nothing
Set rstRep = Nothing

Orders_Exit:
Exit Function

Orders_Err:
MsgBox Error$

Resume Orders_Exit

End Function
 
First Problem

First of all, your error handling is wrong. You should only have to state your error handling statement at the beginning unless you are doing something very complex. You are using "On Error Resume Next". That means that your code will continue no matter what the error is. Since your previous line has an error, it carries through and errors out again. Then you have circular logic and an error loop.

Look at my error handling code and let me know if you need help debugging your program after you get my code going. Here's the link:

http://www.access-programmers.co.uk/forums/showthread.php?t=84206
 
is "Activity_Notes" a memo field?

"out of memory" could be A's way of telling you that it is using an obsolete Excel model (97 if i remember correctly) that only handles 255 chars/cell.

check if long memos are doing this to you.

izy
 

Users who are viewing this thread

Back
Top Bottom