SendObject (send an unique query to each of a list of recipients)

  • Thread starter Thread starter Alison
  • Start date Start date
A

Alison

Hi, I'm completely new to VBA so need a very lay-person's answer.

I need to send an email to 900 email adresses, (Table A = a list of the
email addresses each with a unique identifier).

Each recipient must have have thier attachment, (Table B has the required
information, and also has the unique identifier of the recipient).

Does anyone know how I can do this?

I think that I need a sendobject macro, and that for the "to" argument, I
need to state something that will direct it to pick the recipient names from
Table A. I need the query that filters by the same unique identifier as the
"to", and it need it to replicate this action 900 times for each recipient.
Any ideas?

Thank you guys,
Alison
 
Hi Alison

Here is some code for you. Stteps as follows:

1. Create a query with fields for To and Attachment from your 2 tables
2. Pate the code below into a module
3. Change the To and Attach constants in the code to the names of the fields
in your query
4. Run the sub, supplying as arguememnts your query name and the subject of
your mail

************************************************

Sub OutlookMail(ByVal strQry As String, strSubject As String)
'sub sends email with attachments to list defined in strQry
'change field name constants below to your own field names

Dim outapp As Outlook.Application
Dim mi As Outlook.MailItem
Dim rst As DAO.Recordset
Const TO_FIELD_NAME As String = "To"
Const ATTACH_FIELD_NAME As String = "Attach"

On Error Resume Next
Set outapp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set outapp = New Outlook.Application
End If
Set rst = CurrentDb.OpenRecordset(strQry, dbOpenSnapshot)
Do Until rst.EOF = True
Set mi = outapp.CreateItem(olMailItem)
With mi
.To = rst.Fields(TO_FIELD_NAME).Value
.Subject = strSubject
.Attachments.Add rst.Fields(ATTACH_FIELD_NAME).Value
.Send
End With
rst.MoveNext
Loop
rst.Close
Set mi = Nothing
Set outapp = Nothing
Set rst = Nothing
End Sub
 
Hi Alison

Sorry - forgot to poit out that you have to create a reference to the
outlook object model - in the Access VBA IDE go to Tools references and then
scroll down to Microsoft Outlook 11.0 Object library. Click in the box and
then OK
 
Hi,

Thanks, I've tried as you suggested, (it was outlook 10.0. I don't know if
that makes a difference)

It doesn't seem to recognise the code. The "run" button is greyed out, and
when choosing the "Run" drop dpown, it doesn't list any subs. This changes
if i delete the "ByVal strQry As String, strSubject As String" so that it
reads...

Sub OutlookMail (),

but then it obviously won't work as it comes up with a compile error.

Any ideas?

Thanks,
Alison
 
Hi Alison

Not sure what run button you are talking about!

The procedure that i gave you takes 2 arguments, the name of the query and
the subject of the email.

You can run this in a number of ways - button on a form etc etc but the
easiest is probably just to type in the immediate window (ctrl G):

OutlookMail "your query name", "your subject"

and then hit the enter key
 
Hi,

Sorry, I told you I was completely new to VBA.

My query is called LinkedList and it contains fields including "to", (an
email address) and "attach", (data to be sent to the recipient). So there
are multiple lines for each recipient, and the email addresss is repeated for
each record. (this is correct right?)

I have opened a module in design view and literally pasted your code
word-for-word. I have changed nothing because my field names in the query,
"to" and "attach" exactly match yours.

Should I change something?

The button I was talking about is on the toolbar and is call "Run
Sub/Userform", but it opens a box with a list of Macros to run, (an empty
list).

If I hit Ctrl+G, the immediate box appears but if I type

outlookmail linkedlist,email - and ENTER - Nothing happens
if I type
outlookmail (linkedlist,email) - and ENTER - I get a compile error box
that says
"Expected ="

Do you know what I am doing wrong?

Thanks,
Alison




The first line you gave me is...
Sub OutlookMail(ByVal strQry As String, strSubject As String)
 
Hi Alison

No problem!

You are supplying 2 string arguments to the procedure so you need to enclose
each in double quotes

So if your query name is: LinkedList
eMail subject is (say): Data from Alison

you type in the immediate window:

OutlookMail "LinkedList", "Data from Alison"

and then hit the enter key

This will send one mail for each entry in your query

It might ne more efficient to send one mail with multiple attachments to
each recipient - if I have time later on today I will send you the code
 
Hi, Thankyou.

I did that, and it said Compile Error: User-defined type not defined, and it
highlighted the line of code that said...

Dim rst As DAO.Recordset

I just ordered a VBA book, because it's very frustrating that I don't
understand this.

Thanks for your help, and if I can get this to work the multiple attachments
would be fantastic.

Thanks,
Alison
 
Hi Alison

Problem could be that you may need to set up a reference to the DAO object
library (although I thought this was set up by default)

In VBA go to tools references and check that you have a reference to
Microsoft DAO 3.6 Object library, if not, scroll down to it and click in the
box!
 
Hi Dom,

That worked. Thank you.

The email went to everyone in my list, and with the subject "Data from Alison"
The email body was blank though.

So I have a couple more questions
1. How do I get the subject header to state a record in the query,
i.e.
Recipient (e-mail address removed) to get a subject header "Data for ABC"
Recipient (e-mail address removed) to get get a subject header "Data for 123"

2. How do I send a generic message body to all recipients?
i.e. "Here is your data, blah, blah"

3. How do I attach an attachment?

4. How do I make the attcahment unique to the recipient?
i.e. (e-mail address removed) needs an attachment of a table that is filtered to
contain only (e-mail address removed)'s data. i.e. ABC's list of classes to attend
(e-mail address removed) only wants a table of 123's classes

Thanks,
Sorry its a lot more questions...
Alison
 
Hi Alison

OK I think I understand what you need now.

When you refer to attachment you mean a list of values (classes) derived
from your Table B?

Here is the code you need - just change the constant values to your own

In addition you need to create 2 queries:

1. does not matter what - name it as you define in CLASSES_QRY_NAME below.
2. Named per RECIP_QRY_NAME below is a list of recipipent id's and addresses
that have data in your Table B - ie join your Table A to your table B and
then group your table A fields - this will stop you trying to send something
to recipipients in Table A with No records in Table B

*************************
Sub sendObjectClasses()


Dim rstRecipients As DAO.Recordset 'define
recorset of recipients to run through
Dim qdfClasses As DAO.QueryDef 'define
a queryddef of classes
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 = "qryRecipsWithClasses" 'set up
a query of recipients who have classes
Const RECIP_ID_FIELD_NAME As String = "ID"
'defines recipient ID field name
Const RECIP_ADDRESS_FIELD_NAME As String = "Address"
'defines recipient address field name
Const CLASSES_TBL_NAME As String = "tblClasses"
'defines name of table which lists classes and recipient ID's
Const MESSAGE_TEXT As String = "Here is your data" 'define
message content
Const CLASSES_QRY_NAME As String = "qryClasses" 'set up
a query (any we will change SQL dynamically

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

'define the query whose SQL property we will manipulate
Set qdfClasses = CurrentDb.QueryDefs(CLASSES_QRY_NAME)

'for each recipipient with classes
Do Until rstRecipients.EOF

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

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

'now send qry we have defined for this recipient as an excel
attachment
DoCmd.sendObject ObjectType:=acSendQuery, _
ObjectName:=CLASSES_QRY_NAME, _
OutputFormat:=acFormatXLS, _
To:=strAddress, _
Subject:="Data for " & strName, _
Message:=MESSAGE_TEXT

'move to next recipient in recordset
rstRecipients.MoveNext
Loop
Proc_Exit:
'clean up
rstRecipients.Close
Set rstRecipients = Nothing
Set qdf = Nothing

Proc_Error:
MsgBox Error(Err)
Resume Proc_Exit
End Sub


************************
ps you were right all the time - it ws a send object that you needed!
 
Sorry - last code I posted was buggy - the following works!

Sub sendObjectClasses()


Dim rstRecipients As DAO.Recordset 'define
recorset of recipients to run through
Dim qdfClasses As DAO.QueryDef 'define
a queryddef of classes
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 = "qryRecipsWithClasses" 'set up
a query of recipients who have classes
Const RECIP_ID_FIELD_NAME As String = "MailAddressID"
'defines recipient ID field name
Const RECIP_ADDRESS_FIELD_NAME As String = "MailAddress"
'defines recipient address field name
Const CLASSES_TBL_NAME As String = "zzMailData"
'defines name of table which lists classes and recipient ID's
Const MESSAGE_TEXT As String = "Here is your data" 'define
message content
Const CLASSES_QRY_NAME As String = "qryClasses" 'set up
a query (any we will change SQL dynamically

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

'define the query whose SQL property we will manipulate
Set qdfClasses = CurrentDb.QueryDefs(CLASSES_QRY_NAME)

'for each recipipient with classes
Do Until rstRecipients.EOF

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

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

'now send qry we have defined for this recipient as an excel
attachment
DoCmd.sendObject ObjectType:=acSendQuery, _
ObjectName:=CLASSES_QRY_NAME, _
OutputFormat:=acFormatXLS, _
To:=strAddress, _
Subject:="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 qdfClasses = Nothing
Exit Sub
Proc_Error:
MsgBox Error(Err)
Resume Proc_Exit
End Sub
 
Hi Dom,

Brilliant thank you.

Its now sending an email to all the recipients, and each has a spreadsheet
attachment which is fantastic.

However, the spreadsheet has field names but contains no data. I must have
done something wrong in the query SQL. This is what I have. Is there an
error?

SELECT [Classes List].*, [Classes List].[AttendeeID]
FROM [Classes List] INNER JOIN [Attendee List] ON [Classes
List].[AttendeeID] = [Attendee List].[AttendeeID]
WHERE ([Classes
List].[AtendeeID])="rstRecipients.Fields(RECIP_ID_FIELD_NAME).Value";

Very nearly there I think...

Thanks,
Alison
 
Hi Alison

I think you have a couple of double quotes that you don't need but it is
difficult to see....

The peice of the code which sets the query SQL is:


strSQL = "Select " & CLASSES_TBL_NAME & ".* FROM " &
CLASSES_TBL_NAME _
& " WHERE " & CLASSES_TBL_NAME & "." &
RECIP_ID_FIELD_NAME & "=" _
& rstRecipients.Fields(RECIP_ID_FIELD_NAME).Value

if you had changedthe last line of the code to:

RECIP_ID_FIELD_NAME & "=" _
& "rstRecipients.Fields(RECIP_ID_FIELD_NAME).Value"

Then it might produce something like you have - removing these last 2 double
quotes (as in "rstRecipients and Value") - should fix it.

VBA sees anything surrounded by quotes as text whereas you want that
expression to evaluate to your ID

Have a good weekend!

Dom

Alison said:
Hi Dom,

Brilliant thank you.

Its now sending an email to all the recipients, and each has a spreadsheet
attachment which is fantastic.

However, the spreadsheet has field names but contains no data. I must have
done something wrong in the query SQL. This is what I have. Is there an
error?

SELECT [Classes List].*, [Classes List].[AttendeeID]
FROM [Classes List] INNER JOIN [Attendee List] ON [Classes
List].[AttendeeID] = [Attendee List].[AttendeeID]
WHERE ([Classes
List].[AtendeeID])="rstRecipients.Fields(RECIP_ID_FIELD_NAME).Value";

Very nearly there I think...

Thanks,
Alison



DomThePom said:
Sorry - last code I posted was buggy - the following works!

Sub sendObjectClasses()


Dim rstRecipients As DAO.Recordset 'define
recorset of recipients to run through
Dim qdfClasses As DAO.QueryDef 'define
a queryddef of classes
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 = "qryRecipsWithClasses" 'set up
a query of recipients who have classes
Const RECIP_ID_FIELD_NAME As String = "MailAddressID"
'defines recipient ID field name
Const RECIP_ADDRESS_FIELD_NAME As String = "MailAddress"
'defines recipient address field name
Const CLASSES_TBL_NAME As String = "zzMailData"
'defines name of table which lists classes and recipient ID's
Const MESSAGE_TEXT As String = "Here is your data" 'define
message content
Const CLASSES_QRY_NAME As String = "qryClasses" 'set up
a query (any we will change SQL dynamically

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

'define the query whose SQL property we will manipulate
Set qdfClasses = CurrentDb.QueryDefs(CLASSES_QRY_NAME)

'for each recipipient with classes
Do Until rstRecipients.EOF

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

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

'now send qry we have defined for this recipient as an excel
attachment
DoCmd.sendObject ObjectType:=acSendQuery, _
ObjectName:=CLASSES_QRY_NAME, _
OutputFormat:=acFormatXLS, _
To:=strAddress, _
Subject:="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 qdfClasses = Nothing
Exit Sub
Proc_Error:
MsgBox Error(Err)
Resume Proc_Exit
End Sub
Click to expand...
Click to expand...
 
Back
Top