hi all
Can someone help me with my problem.
I create Query from code as belou and is working OK if query retern only 1 record.But becous normaly i have more then one record , how to send e- mail to more then 1 person ?
--------------- start code ----------------
Private Sub SendToEmail_Click()
On Error GoTo Err_SendToEmail_Click
If IsNull(Me.ReferenceNo) Then
MsgBox " Enter Quotation Reference Number", vbOKOnly, " Empty Field"
Me.ReferenceNo.SetFocus
ElseIf IsNull(Me.Status) Then
MsgBox " Select Status ", vbOKOnly, " Empty Field"
Me.Status.SetFocus
ElseIf IsNull(Me.Delivery) Then
MsgBox "Enter Text in Delivery Instruction ", vbOKOnly, " Empty Field"
Me.Delivery.SetFocus
Else
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Me.Label10.Visible = True
End If
DoEvents
Dim strClient As String
Dim strSQL As String
Dim db As Database
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim rstQOrder As Recordset
Dim strEmailTo As String
Dim strRefNo As String
Dim strBody As String
Set objOutlook = CreateObject("Outlook.Application"

Set objEmail = objOutlook.CreateItem(olMailItem)
' create sql string
strSQL = "SELECT Confirm_O.OrderID, Order.OrderNo, Vessel.VesselName,"
strSQL = strSQL & "Employees.DirectLine, Employees.DepaEmail, Employees.FirstName, "
strSQL = strSQL & "Employees.LastName, Confirm_O.ReferenceNo, Confirm_O.Status, "
strSQL = strSQL & "Confirm_O.Date, Confirm_O.Delivery, Suppliers.Company, "
strSQL = strSQL & "Suppliers.ContactName, Suppliers.SEMailAddress, "
strSQL = strSQL & "Vessel.OwnersID, Owners.OwnerName AS [Text], "
strSQL = strSQL & "Owners.OwnerName, Employees.Title "
strSQL = strSQL & "FROM (Vessel INNER JOIN (Suppliers INNER JOIN (Employees INNER JOIN ([Order] INNER JOIN Confirm_O ON Order.OrderID = Confirm_O.OrderID) "
strSQL = strSQL & "ON Employees.EmployeeID = Order.EmployeeID) ON Suppliers.SupplierID = Order.SupplierID) "
strSQL = strSQL & "ON Vessel.VesselID = Order.VesselID) INNER JOIN Owners ON Vessel.OwnersID = Owners.OwnersID "
strSQL = strSQL & "WHERE Confirm_O.OrderID = " & Forms![confirmOrder].Form![OrderID]
'Get DB and Recordset Pointers
Set db = CurrentDb()
Set rstQOrder = db.OpenRecordset(strSQL)
'Check to see if there are any order details to transfer
If rstQOrder.EOF And rstQOrder.BOF Then
'No order details to transfer
MsgBox "No order details to transfer.", , "No Records"
Me.Label10.Visible = False
Else
strClient = rstQOrder.Fields("Company"

strRefNo = rstQOrder.Fields("ReferenceNo"

strEmailTo = rstQOrder.Fields("SEmailAddress"
strBody = "Fm : " & Chr(13)
strBody = strBody & "Ref : " & strRefNo & Chr(13) & Chr(13)
strBody = strBody & "TO :" & rstQOrder.Fields("ContactName"

& Chr(13) & Chr(13)
strBody = strBody & "RE : We would like to confirm the order according to your quotation." & Chr(13)
strBody = strBody & " Include all certificates where applicable." & Chr(13) & Chr(13)
strBody = strBody & "__________________________________" & Chr(13) & Chr(13)
With objEmail
.To = strEmailTo
.Subject = "Order Confirmation " & Chr$(32) & strRefNo
.Body = strBody
'.Send
.Display
End With
End If
'Close and Release Pointer
'Close rst & db
rstQOrder.Close
Set rstQOrder = Nothing
db.Close
Set db = Nothing
Set objEmail = Nothing
Me.LblMailClient.Visible = False
'Uncomment the next line if you want Outlook to shut down when its done.
'objOutlook.Quit
Exit_SendToEmail_Click:
Exit Sub
Err_SendToEmail_Click:
If Err.Number = 94 Then
Resume Next
ElseIf Err.Number = 2501 Then
Resume Next
Else
MsgBox Err.Number & vbCr & Err.Description
Me.LblMailClient.Visible = False
End If
Exit Sub
End Sub
---------------------- end code -----------------
thanks Fule