Link to home
Start Free TrialLog in
Avatar of bkosterm
bkosterm

asked on

Batch email from access query

I need to query a DB and return a list of email addresses.  Then I'd like to be able to put all those addresses into the "To" field of an email.  
I can see how to send individual mails, but I can't figure out how to build a single mail with many recipients.
Avatar of Guy Hengel [angelIII / a3]
Guy Hengel [angelIII / a3]
Flag of Luxembourg image

You have of course the problem of your query, but you will also come to a quite small limit of emails in the TO/CC/BCC field.
I suggest that you don't try to put more than 10 recipients automatically...

The question is (as you know how to send individual mails), where is your problem putting more than 1 recipient to the TO field?
CHeers
ASKER CERTIFIED SOLUTION
Avatar of James Elliott
James Elliott
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
In the past I've had trouble simply adding a semi-colon delimited list of addresses to the Recipents object, so I resorted to using this routine to add the addresses one by one...

Sub AddToRecipients(sToEmail As String, objMailMessage As Outlook.MailItem, objOutlookRecip As Outlook.Recipient)
  '============================================================
  '     Purpose: Add a semi-colon delimited list of email address to the To: header
  '  Parameters: sToEmail - the delimited list. Each email address is delimited by a semi-colon
  '              objMailMessage - an initialised MailItem object
  '              objOutlookRecip - the recipient object that recieves the emails addresses
  '============================================================
Dim vTemp As Variant
Dim n As Integer
   
    n = 1
    vTemp = Field(sToEmail, ";", n)
    With objMailMessage
        While Not IsNull(vTemp)
            If bVerifyEmailAddress(CStr(vTemp)) Then
                Set objOutlookRecip = .Recipients.Add(CStr(vTemp))
                objOutlookRecip.Type = olTo
            Else
                MsgBox "The email address " & vTemp & "@appears to be invalid.@Please check it and add it manually to the message.", vbInformation, "Email Address Error"
            End If
            n = n + 1
            vTemp = Field(sToEmail, ";", n)
        Wend
    End With
End Sub

So to use this you first create a MailItem and a Recipients object, build a semi-colon delimited list of email addresses, and then call AddToRecipients.

The above routine uses two other helper functions,

Field() which picks out elemets from a delimited list, and bVerifyEmailAddress() which does what it says.

Here is Field()

Function Field(ByVal strSource As String, strSep As String, intN As Integer) As Variant
'Purpose:
'   Returns the Nth element in a delimited list.
'   Input: strSource - the list to search
'             strSep - the delimiter of the list - can be more than one character
'             intN - the ordinal value of the element to be returned
'
' Null is returned if either string parameter is null, or intN <=0 or
' If the separator string is not found
'
'Str = Field("Chuck*Roberts","*",1) would return "Chuck".
Dim strResult As String
Dim strSearch As String
Dim I As Long
Dim lSep As Long
Dim lRightChars As Long

    lSep = 0: I = 0
    If IsNull(strSource) Or strSource = "" Or IsNull(strSep) Or strSep = "" Or intN <= 0 Then
        strResult = ""
    Else
        strSearch = strSource
        While I < intN
            lSep = InStr(strSearch, strSep)
            If lSep > 0 Then ' we found the delimiter string
                I = I + 1 ' count occurance
                If I = intN Then ' this is the one we want
                    strResult = Left$(strSearch, lSep - 1)
                End If
                ' strip off i'th field
                strSearch = Right(strSearch, Len(strSearch) - (lSep + Len(strSep) - 1))
            Else ' did not find our separator string, so return the remainer of the string if the count is ok
                If I = intN - 1 Then '  we have seen N-1 separator strings, so this is the field we want
                                                ' at the end of the search string
                    I = I + 1 ' to terminate the While loop
                    strResult = strSearch
                Else    ' there were less than N-1 fields in the input to return Null
                    strResult = ""
                    I = intN
                End If
            End If
        Wend
    End If
    If strResult = "" Then
        Field = Null
    Else
        Field = strResult
    End If
End Function

and here is bVerifyEmailAddress()

Function bVerifyEmailAddress(CM_Email As String)
' Verify if email address is valid
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
       
    If Not isblank(CM_Email) Then
        ' Create the Outlook session.
        Set objOutlook = CreateObject("Outlook.Application")
       
        ' Create the message.
   
        Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
       
        With objOutlookMsg
             ' Add the To recipient(s) to the message.
             Set objOutlookRecip = .Recipients.Add(CM_Email)
            ' Resolve each Recipient's name.
            For Each objOutlookRecip In .Recipients
                If Not objOutlookRecip.Resolve = True Then
                    objOutlookRecip.Delete
                    bVerifyEmailAddress = False
                Else
                    bVerifyEmailAddress = True
                End If
            Next
        End With
        Set objOutlookRecip = Nothing
        Set objOutlookMsg = Nothing
        Set objOutlook = Nothing
    Else
        bVerifyEmailAddress = False
    End If
End Function
Avatar of j1skinner
j1skinner

You stated that you dont have a problem creating the email to send it is just creating a list of multiple recipients.  This will work to create the distribution list based on your query.



Private Sub Command6_Click()
'[me.emailaddress] is the individuals email address on my form.
'[me.text4] is just a text box I used to test what would output.
'This works I am using it now for a distribution list and it is simple.


Dim emaillist 'This will be your email list.
DoCmd.GoToRecord , , acFirst 'Locate the first record in a record set.

'I used this next line to tell me when I was at the end of my records.  It works for me.
Do While Me.NewRecord = False

'This adds records email address and will loop through all records until it reaches the last record(new).
emaillist = emaillist & "; " & Me.EmailAddress
DoCmd.GoToRecord , , acNext
emaillist = emaillist & "; " & Me.EmailAddress
Loop

'I simply am outputting this to a text box on my form but you could easily put this in you "TO:" recipients.

Me.Text4 = emaillist

End Sub
by now (june 2, 2002) , using the outlook library is pretty much 'asking for trouble', since versions of ms office change more often than Bill Gates changes underware.

Instead i would go for the real job, sent your mails directly via SMTP

In the next link u will find a component u have to register on your comp before u can use it; http://www.freevbcode.com/ShowCode.Asp?ID=109

if u have trouble using it, just ask away,

cheers
Ricky
j1skinner,

hi, welcome to EE (u almost are a dinosaur here)
In many TA (not only the Access TA) it is common practice to only post comments.
That way the Q dont get 'lost' in the 'Locked questions', not very frequently visited by experts, thus decreasing the chance for the questioner to receive the help(s)he needs.

not meant to offend, only to help,

cheers
Ricky
Question dead ?

No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
 - Answered by: jell
Please leave any comments here within the
next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER !

Nic;o)
Per recommendation, force-accepted.

Netminder
CS Moderator