Email 180 column table/view dilemna

[danlin99]

Hi -

I used the following codes below in my 1st version to email a report to each
salesrep with no until the new request to add the contact list info. Now I'm
getting 'record too large' error msg when running the make table query to
create the Master_Table. There are close to 200 column with more than 4000
characters in a record exceeding Access limit. The code requires a table and
not a view or select query for the code below to work but I hope someone has
a workaround on this. Select query works so option #2 may be a solution.
Can someone please help modify the codes of sending email to each AM with
attachment of their own sales opportunity report?

I thinking of 2 options:

1) Use select query instead of table (if possible).

Here is the select query for the attachment that query on two tables :

SELECT Main_table.*, [Contact_List].*
'FROM Main_table LEFT JOIN Contact_List ON Main_table.[HIMSS ID#] =
[Contact_List].[UNIQUE ID]
'WHERE (((Main_table.[AM User Id])="JohnDoe"));

2) Export the select query result to Excel template.xls. Save as report.xls
and send email. Repeat the process. There are 300 salesrep to send email to.

------------------------------------------------------------------------------------------------

This is the code that was working before the addition of Contact columns.

Sub sendHIMSSRpt()

Dim rstRecipients As DAO.Recordset
'define recordset of recipients to run through
Dim qdfAMrpt As DAO.QueryDef
'definea queryddef of attachment AM table
Dim strSQL As String
'variable to hold SQL statement
Dim strAddress As String
'varialble to hold address
Dim strName As String
'varialble to hold name
Const RECIP_QRY_NAME As String = "200_10 Email_List"
'set up a query of recipients who have data
Const AM_RPT_QRY_NAME As String = "100_999_Master_Report_Per_AM"
'set up a query (any - will change SQL dynamically
Const RECIP_ID_FIELD_NAME As String = "AM_USER_ID_FINAL"
'defines recipient ID field name
Const RECIP_ADDRESS_FIELD_NAME As String = "AM_USER_ID_EMAIL"
'defines recipient address field name
Const MASTER_TBL_NAME As String = "Master_Table"
'defines name of table which lists HIMSS and recipient ID's

Const MESSAGE_TEXT As String = "This email was sent through MS Access
automation using vba codes. This is a test to see if email security warning
was successfully suppressed" 'define Message content

'set up error handler
On Error GoTo Proc_Error
'open a recordset of recipients with HIMMS data
Set rstRecipients = CurrentDb.OpenRecordset(RECIP_QRY_NAME, dbOpenSnapshot)

'define the query whose SQL property will be manipulated
Set qdfAMrpt = CurrentDb.QueryDefs(AM_RPT_QRY_NAME)

'for each recipient
Do Until rstRecipients.EOF

'define current address and AM name
strAddress = rstRecipients.Fields(RECIP_ADDRESS_FIELD_NAME).Value
strName = Left(strAddress, InStr(1, strAddress, "@") - 1)

'change the query SQL to extract HIMMS data for this recipient only
strSQL = "Select " & MASTER_TBL_NAME & ".* FROM " & MASTER_TBL_NAME _
& " WHERE " & MASTER_TBL_NAME & "." & RECIP_ID_FIELD_NAME & "=" _
& "'" & rstRecipients.Fields(RECIP_ID_FIELD_NAME).Value & "'"

qdfAMrpt.sql = strSQL

'now send qry defined for this recipient as an excel Attachment
DoCmd.SendObject ObjectType:=acSendQuery, _
ObjectName:=AM_RPT_QRY_NAME, _
OutputFormat:=acFormatXLS, _
To:=strAddress, _
Subject:="****THIS IS A TEST ONLY **** HIMSS Data for " & strName, _
MessageText:=MESSAGE_TEXT, _
EditMessage:=False

'move to next recipient in recordset
rstRecipients.MoveNext
Loop

Proc_Exit:
'clean up
On Error Resume Next
rstRecipients.Close
Set rstRecipients = Nothing
Set qdfAMrpt = Nothing
Exit Sub
Proc_Error:
MsgBox Error(Err)
Resume Proc_Exit
End Sub



Thank you.