Dear asafb,
Try this; the code has been slightly changed around to concatenate a list of users. I've also put in a default .txt file name for the e-mail body and a default .doc file for an attachment.
Option Compare Database
Option Explicit
' You need to declare a reference to the Outlook library, and the filesystemobject.
'
' Look in the menu above, and click Tools, then select References
'
' Scroll down the list until you see:-
' Microsoft Scripting Runtime - check it
' Microsoft Outlook Object Library - check it
' Micosoft DAO Object Library - check it
Public Function SendEMailTest()
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 Attachment As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
Dim ToList As String
Set fso = New FileSystemObject
'Ask for the Subject of the e-mail
Subjectline$ = InputBox$("Please enter the subject line for this E-Mail", "Batch E-Mails"
'If there's no subject, call it a day.
If Subjectline$ = "" Then
MsgBox "No subject line entered" & vbNewLine & vbNewLine & "Quitting...", vbCritical, "Batch E-Mails"
Exit Function
End If
'Now we need a body for the e-mail
BodyFile$ = InputBox$("Please enter the filename of the body of the message.", "Batch E-Mails", "C:\Guides.txt"
'If there's nothing to say, call it a day.
If BodyFile$ = "" Then
MsgBox "No message body" & vbNewLine & vbNewLine & "Quitting...", vbCritical, "Batch E-Mails"
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, "Batch E-Mails"
Exit Function
End If
'Since we got a file, we can open it up.
Set MyBody = fs
penTextFile(BodyFile, ForReading, False, TristateUseDefault)
'and read it into a variable.
MyBodyText = MyBody.ReadAll
'and close the file.
MyBody.Close
'Is there an attachment?
Attachment$ = InputBox$("Please enter the filename of any attachment to the message.", "Batch E-Mails", "C:\Guides.doc"
If Not Attachment$ = "" Then
'Check to make sure the file exists...
If fso.FileExists(Attachment$) = False Then
MsgBox "The attachment file isn't where you say it is. " & vbNewLine & vbNewLine & "Quitting...", vbCritical, "Batch E-Mails"
Exit Function
End If
End If
' 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("tblEMails"
'Loop through our list of addresses, adding them to e-mails and sending them if the FLAG is set
Do Until MailList.EOF
'Check the Flag
If Not MailList("EMail Flag"
Then GoTo EMailLoop
' This addresses it
ToList = ToList & MailList("E-Mail"
& ";"
'And on to the next one...
EMailLoop:
MailList.MoveNext
Loop
' This creates the e-mail
Set MyMail = MyOutlook.CreateItem(olMailItem)
' This addresses it
MyMail.To = ToList
'This gives it a subject
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
'This gives it the attachment
If Not Attachment$ = "" Then
MyMail.Attachments.Add Attachment$
End If
'This sends it!
MyMail.Display
'Cleanup
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
