Email with Bcc only. No attachments

[shuddle]

Wait !! I closed the DB and went back in. I now see emails in the Immediate. I still get the runtime error but we're making progress.

[Gicu]

Change the last line to:

DoCmd.SendObject acSendNoObject, , , sEmails, , , , , , True

You should now get a new Outlook message with the Bcc line populated. Examine the list for any bad email.

Cheers,

[Gicu]

Also change this line:

sEmails = Left(sEmails, Len(sEmails) - 1) 'trim the last comma

to:

sEmails = Trim(Left(sEmails, Len(sEmails) - 1)) 'trim the last comma and any leading or ending spaces

Cheers,

[Gicu]

Also you must ensure that you're query is not including any records without an email address, add Is Not Null in the criteria row of the [Email] field in the source query.

Cheers,
Vlad

[Gicu]

I think this updated code would work and it is more flexible as it allows you to attach external files as attachments if needed.

Option Compare Database
Option Explicit


Private Sub Command0_Click()


Dim sEmails As String
Dim qdf As QueryDef, prm As Parameter, rst As DAO.Recordset


Set qdf = CurrentDb.QueryDefs("Q_All_Emails_no_dups")
For Each prm In qdf.Parameters
	prm.Value = Eval(prm.Name)
Next prm


Set rst = qdf.OpenRecordset


Set rst = CurrentDb.OpenRecordset("Q_All_Emails_no_dups")
sEmails = ""
Do Until rst.EOF
	If Not IsNull(rst("[Email]")) then sEmails = sEmails & rst("[Email]") & ";"
rst.movenext
Loop


sEmails = Trim(Left(sEmails, Len(sEmails) - 1)) 'trim the last semi-colon and any leading and trailing spaces


'Debug.Print sEmails
'DoCmd.SendObject acSendNoObject, , , , , sEmails, , , , False
'use Outlook autmotation instead of SendObject
Call vcSendEmail_Outlook_With_Attachment ("Test email bCC","","",sEmails,"","Please review this test email")
End Sub






Function vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon 
   
    Set OutMail = OutApp.CreateItem(0)
 
    OutMail.To = sTo
    If sCC <> "" Then OutMail.CC = sCC
    If sBcc <> "" Then OutMail.BCC = sBcc
    OutMail.Subject = sSubject
    If sBody <> "" Then OutMail.HTMLBody = sBody  


    If sAttachment <> "" Then OutMail.Attachments.Add (sAttachment)


    OutMail.Display  'Send | Display
'    OutMail.Inspector.Activate
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Cheers,
Vlad

[shuddle]

Good morning, Here I am again.

I didn't add your extra script. I want to get the first part working. Here is what I have but I am getting a compile error on acSendNoObject. I have tried it with the true and false.

Option Compare Database
Option Explicit




Private Sub Command0_Click()
Dim sEmails As String
Dim qdf As QueryDef, prm As Parameter, rst As DAO.Recordset
Set qdf = CurrentDb.QueryDefs("Q_All_Emails_no_dups")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm




Set rst = qdf.OpenRecordset




Set rst = CurrentDb.OpenRecordset("Q_All_Emails_no_dups")
sEmails = ""
Do Until rst.EOF
If Not IsNull(rst("[Email]")) Then sEmails = sEmails & rst("[Email]") & ";"
rst.movenext
Loop


sEmails = Trim(Left(sEmails, Len(sEmails) - 1)) 'trim the last semi-colon and any leading and trailing spaces




Debug.Print sEmails
DoCmd.SendObject acSendNoObject, , , , , sEmails, , , , True

[shuddle]

Fixed that. Getting the Runtime error 2295 on the DoCmd.SendObject acSendNoObject,,,,,sEmails,,,,True

[shuddle]

In the Immediate screen the emails have carriage returns, it's not one long string. Could that be the problem? How do we get the carriage return out?

[Gicu]

Are the emails stored with in the table with carriage returns? How are they entered? You can try to use replace to remove them:

sEmails = Trim(Left(sEmails, Len(sEmails) - 1)) 'trim the last semi-colon and any leading and trailing spaces
sEmails=Replace(sEmails,vbCrLn,"")

My other script was not an addition but a replacement, replacing one method of emailing (Docmd.SendObject) with another (Outlook Automation).

Cheers,
Vlad

[shuddle]

Welcome back to my nightmare

Here is what I have. It is giving a run-time error 2482 Microsoft Access cannot find the name 'Tbl_DO_Stakeholder_data' you entered in the expression. It highlights the prm.Value =Eval(prm.Name) section

Option Compare Database
Option Explicit




Private Sub Command0_Click()




Dim sEmails As String
Dim qdf As QueryDef, prm As Parameter, rst As DAO.Recordset




Set qdf = CurrentDb.QueryDefs("Q_All_Emails_no_dups")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm




Set rst = qdf.OpenRecordset




Set rst = CurrentDb.OpenRecordset("Q_All_Emails_no_dups")
sEmails = ""
Do Until rst.EOF
If Not IsNull(rst("[Email]")) Then sEmails = sEmails & rst("[Email]") & ";"
rst.movenext
Loop




sEmails = Trim(Left(sEmails, Len(sEmails) - 1)) 'trim the last semi-colon and any leading and trailing spaces
sEmails = Replace(sEmails, vbCrLf, "")




'Debug.Print sEmails
'DoCmd.SendObject acSendNoObject, , , , , sEmails, , , , False
'use Outlook autmotation instead of SendObject
Call vcSendEmail_Outlook_With_Attachment("Test email bCC", "", "", sEmails, "", "Please review this test email")
End Sub












Function vcSendEmail_Outlook_With_Attachment(sSubject As String, sTo As String, Optional sCC As String, Optional sBcc As String, Optional sAttachment As String, Optional sBody As String)
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

Set OutMail = OutApp.CreateItem(0)

OutMail.To = sTo
If sCC <> "" Then OutMail.CC = sCC
If sBcc <> "" Then OutMail.BCC = sBcc
OutMail.Subject = sSubject
If sBody <> "" Then OutMail.HTMLBody = sBody




If sAttachment <> "" Then OutMail.Attachments.Add (sAttachment)




OutMail.Display 'Send | Display
' OutMail.Inspector.Activate
Set OutMail = Nothing
Set OutApp = Nothing
End Function

[shuddle]

OH! IT Worked...everything looks great!!!!! Thank you, thank you, thank you!

[Gicu]

Can you show the query? Is that a parameter in it?
The best at this point would be if you could start with a new Access file, import the table having the email field (Tbl_DO_Stakeholder_data), the query (Q_All_Emails_no_dups) in which you renamed the PCO_Email to Email and the form where you want to do the emailing. Remove all but a couple of records from the table and make sure there is no sensitive data. Compact the new file, zip it and upload it here (at the top of the forum page there is info how to attach files).

Cheers,
Vlad

[Gicu]

Using Docmd.SendObject or Outlook automation? In any case, great work!
Good luck with your project !
Cheers,
Vlad