Code: Select all
Option Compare Database
Public Sub SendMessage()
Dim strbcc As String
Dim strmsg As String
Dim dbsmember As Database
Dim rstmembers As Recordset
Set dbsmember = CurrentDb()
Set rstmembers = _
dbsmember.OpenRecordset("qryEmail alone for broadcast messages-combined", dbOpenDynaset)
On Error GoTo err1
'
' added Desert Sage to broadcast messages - Oct. 2007 -- CSW
'
strbcc = ""
rstmembers.MoveFirst
Do While Not rstmembers.EOF
With rstmembers
If Not IsNull(!strE_MAIL) Then
strbcc = strbcc & ![strE_MAIL] & ";"
End If
End With
rstmembers.MoveNext
Loop
Set rstmembers = Nothing
'strmsg = "<p><font face=""Arial"" size=""3"">The message below has been sent by the ALLV Broadcast system. <br><b>Please do not reply to this message.</b> Thank you. <br>______________________________________________________________________</font></p>"
strmsg = "<p><font face=""Arial"" size=""3"">The message below has been sent by the ALLV Broadcast system. <br><b>Please do not reply to this message. Replies to this message will be sent back to the ALLV address and will not reach the intended recipient. <u>To contact the original sender, forward this message to him/her and add your reply to that message.</u></b><br> <br>Thank you. <br>______________________________________________________________________</font></p>"
'DoCmd.SendObject acSendNoObject, , , , , strbcc, "Enter Message Subject Here", strmsg, yes
'DoCmd.SendObject acSendNoObject, , htm, , , strbcc, "Enter subject here", , True, "C:Documents and Settings\Administrator\Desktop\email template.htm"
Dim strEmail, strsubject As String, strBody As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.application", "localhost")
Set objEmail = objOutlook.CreateItem(olMailItem)
'strEmail = " a @ b.c"
'strBody = "Make this <B>bold</B> and <BR>add a line."
'strSubject = "Subject"
With objEmail
.BCC = strbcc
.Subject = "Enter Message Subject here"
.HTMLBody = strmsg
'.Send 'Will cause warning message
.Display
End With
Set objEmail = Nothing
err1:
Exit Sub
End Sub
1 - Receiving a message after the message goes into the Outlook Sent Items folder. See attached. 2 - Messages are received twice although there is only one entry in the Sent Items folder.
As a test, I deleted all email addresses that begin with A and B, thereby reducing the number of recipients. Including the A's and B's, there were 351 recipients. I didn't count the reduced list but I would guess about 30-40 addresses were eliminated. Results: Without the A's and B's, (1) no error message appeared and (2) message was received once, as expected.
So, what I would like to do is modify the above code to send the message out in groups of, say, 200 (I'd make this a parameter) without the user having to enter the message more than once.
Any suggestions would be greatly appreciated.
)
