Send Specific Query Results As Body Of Email To Seperate Addresses

[sxwend]

I am trying to use the following post results (http://www.thescripts.com/forum/thread189759.html) and add another requirement. I need to send the results to just the email addresses that the query specifies for each record... Essentially this is a make shift Ordering Tool and I want to be able to notify the receiver of the order and its specifics.

q_Order_Detail_4email consists of
[Contact Email],[ID],[Product_1],[Quantity_1] and [Product_PO_1]
Example:
[e-mail],956,Modem,1000,xyz123
[e-mail],957,USB,500,zyx321

In this case I need for two emails to be generated with one line of data in the results on each email.

Function GetOrderBody() As String
On Error GoTo GetOrderBody_Err
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strInfo As String
 
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("q_Order_Detail_4email", dbOpenForwardOnly, dbReadOnly)
 
While Not rst.EOF
 
strInfo = strInfo & rst!ID & vbTab
strInfo = strInfo & rst!Product_1 & vbTab
strInfo = strInfo & rst!Quantity_1 & vbTab
strInfo = strInfo & rst!Product_PO_1 & vbCrLf
rst.MoveNext
Wend
 
GetOrderBody = strInfo
 
GetOrderBody_Exit:
    Exit Function
 
GetOrderBody_Err:
    MsgBox Error$
    Resume GetOrderBody_Exit
 
End Function

Public Function EOT_OPR_SendEMail()
 
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
 
 
Set fso = New FileSystemObject
 
 ' First, we need to know the subject.
 ' We can't very well be sending around blank messages...
 
Subjectline$ = "Equipment Ordering Tool - Order Placed"
'Subjectline$ = InputBox$("Please enter the subject line for this mailing.", _
                 "We Need A Subject Line!")
 
 ' If there's no subject, call it a day.
 
If Subjectline$ = "" Then
    MsgBox "No subject line, no message." & vbNewLine & vbNewLine & _
        "Quitting...", vbCritical, "E-Mail Merger"
    Exit Function
End If
 
 ' Now we need to put something in our letter...
 
BodyFile$ = "\\CO1860-IMRPTNG\Automation\EOT-Order_Placed_Recipient.txt"
 
 ' If there's nothing to say, call it a day.
 
If BodyFile$ = "" Then
    MsgBox "No body, no message." & vbNewLine & vbNewLine & _
         "Quitting...", vbCritical, "I Ain't Got No-Body!"
    Exit Function
End If
 
 ' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
    MsgBox "The body file isn't where you say it is. " & vbNewLine & vbNewLine & _
           "Quitting...", vbCritical, "I Ain't Got No-Body!"
    Exit Function
End If
 
   ' Since we got a file, we can open it up.
    Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)
 
   ' and read it into a variable.
    MyBodyText = MyBody.ReadAll
 
   ' and close the file.
    MyBody.Close
 
   ' Now, we open Outlook for our own device..
    Set MyOutlook = New Outlook.Application
 
 
 ' Set up the database and query connections
 
    Set db = CurrentDb()
 
    Set MailList = db.OpenRecordset("q_Order_Detail_4email", dbOpenForwardOnly, dbReadOnly)
 
 ' now, this is the meat and potatoes.
 ' this is where we loop through our list of addresses,
 ' adding them to e-mails and sending them.
 
    Do Until MailList.EOF
 
        ' This creates the e-mail
 
        Set MyMail = MyOutlook.CreateItem(olMailItem)
 
            ' This addresses it
            MyMail.To = MailList("Contact Email")
 
            'This gives it a subject
            MyMail.Subject = Subjectline$
 
            'This gives it the body
            MyMail.Body = MyBodyText
 
 
            'If you want to send an attachment
            'uncomment the following line
 
            'MyMail.Attachments.Add "c:\dbgout.txt", olByValue, 1, "My Displayname"
            'MyMail.Attachments.Add "c:\dbgout.txt", olByValue, 1, "My Displayname2"
 
            ' To briefly describe:
            ' "c:\myfile.txt" = the file you want to attach
            '
            ' olByVaue = how to pass the file.  olByValue attaches it, olByReference creates a shortcut.
            '      the shortcut only works if the file is available locally (via mapped or local drive)
            '
            ' 1 = the position in the outlook message where to attachment goes.  This is ignored by most
            '      other mailers, so you might want to ignore it too.  Using 1 puts the attachment
            '      first in line.
            '
            ' "My Displayname" = If you don't want the attachment's icon string to be "c:\myfile.txt" you
            '      can use this property to change it to something useful, i.e. "4th Qtr Report"
 
 
 
            'This sends it!
            MyMail.Send
 
            'Some people have asked how to see the e-mail
            'instead of automaticially sending it.
            'Uncomment the next line
            'And comment the "MyMail.Send" line above this.
 
            'MyMail.Display
 
 
 
    'And on to the next one...
    MailList.MoveNext
 
Loop
 
 'Cleanup after ourselves
 
Set MyMail = Nothing
 
 
'Uncomment the next line if you want Outlook to shut down when its done.
'Otherwise, it will stay running.
 
'MyOutlook.Quit
Set MyOutlook = Nothing
 
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
 
End Function

Any help would be greatly appreciated.

[MMcCarthy]

I don't think you need to be that complicated. Try this instead....

Function GetOrderBody() As String
On Error GoTo GetOrderBody_Err
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strInfo As String
 
    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("q_Order_Detail_4email", dbOpenForwardOnly, dbReadOnly)
 
Do Until rst.EOF
 
    strInfo = strInfo & rst!Id & vbTab
    strInfo = strInfo & rst!Product_1 & vbTab
    strInfo = strInfo & rst!Quantity_1 & vbTab
    strInfo = strInfo & rst!Product_PO_1 & vbCrLf
    DoCmd.SendObject acSendNoObject, , , rst![Contact Email], , , "Order Details", strInfo
    rst.MoveNext
Loop
 
GetOrderBody_Exit:
    Exit Function
 
GetOrderBody_Err:
    MsgBox Error$
    Resume GetOrderBody_Exit
 
End Function