Hi
A long time ago I found on the web a simular script. please find below the
code.
rember that witin my query the third colomn contains the e-mail address.
Function fEmailTextFromForm()
On Error GoTo Err_fEmailTextFromForm
'***********************************************************
' Diming all variables
'***********************************************************
Dim strEmailTo As Variant
Dim dbsCurrent As Database
Dim rstRecords As Recordset
Dim SendWhat As String
Dim rstKey As Variant
Dim rstKey2 As Variant
Dim rptSubject As String
Dim rstAccount As Variant
Dim rptMessageText As String
Dim What2Send As Variant 'Access.AcSendObjectType
Dim Object2Send
'********************************************************************************************
' Setting database and recordset variable
'********************************************************************************************
SendWhat = "EmailAddresses" ' Name of query or table
rstKey = "[EmailAddress]" ' A key field
rstKey2 = "![EmailAddress]" ' A key field
Object2Send = Forms!frmMessage!cboObjects.Column(2)
' The values for the ObjectType and MSysObjects are different.
'
' AcSendObjectType MSysObjects
' Value Constant Value Constant
' 6 acSendDataAccessPage
' 2 acSendForm -32768 form
' 5 acSendModule -32761 module
' -1 acSendNoObject
' 1 acSendQuery 5 query
' 3 acSendReport -32764 report
' 0 acSendTable 1 or 5 table
Select Case Object2Send ' Evaluate Number.
Case 1
What2Send = 0
Case 6
What2Send = 0
Case 5
What2Send = 1
Case -32764
What2Send = 3
Case -32768
What2Send = 2
Case Else ' Other values.
What2Send = -1 '"Not a valid number"
End Select
Set dbsCurrent = CurrentDb()
Set rstRecords = dbsCurrent.OpenRecordset(SendWhat, dbOpenDynaset)
rptSubject = [Forms]![frmMessage]![txtSubject].Value
rptMessageText = [Forms]![frmMessage]![txtMessage].Value '_
'& vbCrLf & vbCrLf & "Your Name can go here" _
'& vbCrLf & "Your email address here"
'********************************************************************************************
' Walking through a recordset until end of file, setting the global variable
' strEmailTo to the current where and using SendObject passing
' email address and report name
'********************************************************************************************
If MsgBox("Sending mail to everyone" & Chr(13) & "within the distribution
list?" & Chr(13) & SendWhat, 4) = 6 Then
'DoCmd.OpenForm "frmSending" ', , , , , acDialog
With rstRecords
Do Until .EOF
strEmailTo = "rstKey = '" & rstKey2 & " '" ' sets global strEmailTo
DoCmd.SendObject What2Send, Forms!frmMessage!cboObjects.Column(0),
acFormatRTF, ![EmailAddress], , , rptSubject, rptMessageText, False, ""
'DoCmd.SendObject acSendNoObject, , acFormatTXT, ![EmailAddress], ,
, rptSubject, rptMessageText, False, ""
.MoveNext ' Move to next record in Recordset
Loop
End With
'DoCmd.Close acForm, "frmSending", acSaveNo
MsgBox "All Done!"
End If
Exit_fEmailTextFromForm:
Exit Function
Err_fEmailTextFromForm:
Select Case Err
Case 0 'insert Errors you wish to ignore here
Resume Next
Case Else 'All other errors will trap
Beep
MsgBox Error$, , "Error in function modUtility.fEmailTextFromForm"
Resume Exit_fEmailTextFromForm
End Select
Resume 0 'FOR TROUBLESHOOTING
End Function
