Public Function SendEMailAllActive()
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 strMsgBody As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim strEmailList As String ' for building the To: string

Set fso = New FileSystemObject
Subjectline$ = InputBox$("Please enter the Subject line for this mailing.", _
"Tennis Center Business Manager 2007")
MyBodyText$ = Forms!YOurMainFormName.YourControlWithTheMessage
If Subjectline$ = "" Then
MsgBox "You have not entered a Subject Line for this Email." & vbNewLine & vbNewLine & _
"This will cancel your Email.", vbCritical, "Tennis Center Business Manager 2007"
Exit Function
End If
Set MyOutlook = New Outlook.Application
Set db = CurrentDb()
Set MailList = db.OpenRecordset("MyEmailAddressesAllActive")

Do Until MailList.EOF
	strEmailList = strEmailList & MailList("email") & ";"
MailList.MoveNext

Loop
Set MyMail = MyOutlook.CreateItem(olMailItem)
MyMail.To = MailList("email")
MyMail.Subject = Subjectline$
MyMail.Body = MyBodyText$
MyMail.Display