U
Ultraviolet47
Hi
I have code that opens up an email based on a query from Access. It
puts it in the To field, but it's a newsletter and needs to go in the
BCC field. I ahve tried placing BCC in various places, but no luck. ANy
ideas please?
Much appreciated!
Public Function SendEmailUpdates()
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
'Enter the subject line
Subjectline$ = InputBox$("Please enter the subject line for this
mailing.", _
"Subject Line")
' If there's no subject, quit.
If Subjectline$ = "" Then
MsgBox "Email composition cancelled" & vbNewLine & vbNewLine & _
"", vbCritical, "Outlook Email "
Exit Function
End If
' Enter body text
BodyFile$ = InputBox$("Please enter the location of the filename of the
body of the message.", _
"Enter location of .txt file")
' If there's no body, quit.
If BodyFile$ = "" Then
MsgBox "Email composition cancelled" & vbNewLine & vbNewLine & _
"", vbCritical, "Outlook Email"
Exit Function
End If
' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file cannot be found, please check the location. "
& vbNewLine & vbNewLine & _
"Email composition cancelled", vbCritical, "No file found."
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
' 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("Qry_UpdatesOE")
' 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
' We need to move it BEFORE we start the loop, since
' we don't want to make a bunch of e-mails, we just want one.
Set MyMail = MyOutlook.CreateItem(olMailItem)
' now, this is the meat and potatoes.
' this is where we loop through our list of addresses,
' and we add them to the RECIPIENTS collection
Do Until MailList.EOF
' This adds the address to the list of recipients
MyMail.Recipients.Add MailList("email")
'And on to the next one...
MailList.MoveNext
Loop
' And now that we've addressed it, we can finish composing
the rest of the fields.
'This gives it a subject
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
' This sends it!
'MyMail.Send
MyMail.Display
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
I have code that opens up an email based on a query from Access. It
puts it in the To field, but it's a newsletter and needs to go in the
BCC field. I ahve tried placing BCC in various places, but no luck. ANy
ideas please?
Much appreciated!
Public Function SendEmailUpdates()
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
'Enter the subject line
Subjectline$ = InputBox$("Please enter the subject line for this
mailing.", _
"Subject Line")
' If there's no subject, quit.
If Subjectline$ = "" Then
MsgBox "Email composition cancelled" & vbNewLine & vbNewLine & _
"", vbCritical, "Outlook Email "
Exit Function
End If
' Enter body text
BodyFile$ = InputBox$("Please enter the location of the filename of the
body of the message.", _
"Enter location of .txt file")
' If there's no body, quit.
If BodyFile$ = "" Then
MsgBox "Email composition cancelled" & vbNewLine & vbNewLine & _
"", vbCritical, "Outlook Email"
Exit Function
End If
' Check to make sure the file exists...
If fso.FileExists(BodyFile$) = False Then
MsgBox "The body file cannot be found, please check the location. "
& vbNewLine & vbNewLine & _
"Email composition cancelled", vbCritical, "No file found."
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
' 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("Qry_UpdatesOE")
' 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
' We need to move it BEFORE we start the loop, since
' we don't want to make a bunch of e-mails, we just want one.
Set MyMail = MyOutlook.CreateItem(olMailItem)
' now, this is the meat and potatoes.
' this is where we loop through our list of addresses,
' and we add them to the RECIPIENTS collection
Do Until MailList.EOF
' This adds the address to the list of recipients
MyMail.Recipients.Add MailList("email")
'And on to the next one...
MailList.MoveNext
Loop
' And now that we've addressed it, we can finish composing
the rest of the fields.
'This gives it a subject
MyMail.Subject = Subjectline$
'This gives it the body
MyMail.Body = MyBodyText
' This sends it!
'MyMail.Send
MyMail.Display
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