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
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