Email Data and Addresses from Table

I have rudimentary have code which outputs "Compile error:  Type mismatch" in the sample attached database.  I will need to create an email to a list of addresses from 'tblEmailAddresses'.  Also, I need to include data from a query or table ('tblEmailData') into the email's contents.  I want to have the email sent to my draft folder before sending.

Please help me put together something which works.
Email-DB-TEST.accdb
LVL 1
CFMIFinancial Systems AnalystAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
COACHMAN99Connect With a Mentor Commented:
these are parameters you pass to the emailing function
recipemail could be 'whoever@wherever.com'
cc1 (if you are cc'ing someone) is the same format
body is the body of the email
don't worry about the programs lookup - that was my app specific..
as I said above, you replace my body with your HTML body.
If you are sending a bunch of different emails with different body, subject, recipient then ideally you would assemble these outside the function and pass as parameters.

the calling code could look like:

SendEmail("whoever@wherever.com", "a message from me", "a whole bunch of text as in your html body below", "whoever@wherever.com")

If your body is HTML it may be easier to assemble it directly as you are doing, in which case you wouldn't pass the parameters. If the body is not constant , you would need to cycle through the records within the emailing function.

If you are still struggling with the programming aspects of this you may want to consider Luke's suggestion (above)
0
 
COACHMAN99Commented:
Hi,
I would prefer not to open too many access databases to start, but can you send the line of code that is triggering the error? Press control break when it happens, and copy/paste the highlighted line if possible.
0
 
CFMIFinancial Systems AnalystAuthor Commented:
Addressee = DLookup("EmailAddress", CRTb, "e-mail = 'y'") causes error in code below.

Function SendRpts()
DoCmd.SetWarnings False
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
     Set appOutLook = CreateObject("Outlook.Application")
     Set MailOutLook = appOutLook.CreateItem(olMailItem)
Dim Addressee As String
Dim ContactEM As String
Dim FirstnameC As String
Dim SourceTable As String
Dim sUser As String
Dim User As String
Dim EmailAddress As String
Dim CDb As Database, CRTb As DAO.Recordset
   Set CDb = CurrentDb
   Set CRTb = CDb.OpenRecordset("tblEmailAddresses")
    Set CRTb = DBEngine(0)(0).OpenRecordset("(SELECT * from tblEmailAddresses where e-mail = 'y')")
        Dim ExportDir As String
        Dim NewRef As String

    NewRef = Format(Now(), "yyyy")
'    NewRef = Format(Date - 1, "mmddyy")
    ExportDir = "C:\"
    sUser = Environ("username")
    User = DLookup("F_Name", "tblUsers", "UserID = 'sUser'")

Addressee = DLookup("EmailAddress", CRTb, "e-mail = 'y'")
ContactEM = DLookup("L_Name", "tblEmailAddresses")
FirstnameC = DLookup("F_Name", "tblEmailAddresses")


Do While Not CRTb.EOF
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = CRTb.EmailAddress
'            .To = DLookup("EmailAddress", "tblEmailAddresses")
            .Subject = "CI.Milestone Invoice"
            .HTMLBody = "Users,   " & "<BR>" & "<BR>" & _
            "Invoice # - " & "<BR>" & "<BR>" & _
            "Date - " & "<BR>" & "<BR>" & _
            "CI Amount - $" & "<BR>" & "<BR>" & _
            "DTD - $" & "<BR>" & "<BR>" & _
            "Total - $" & "<BR>" & "<BR>" & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you.") & "<BR>" & "<BR>" & _
            "Jimmie" & "<BR>" & "<BR>" & _
            "CI Finance and Asset Reporting" & "<BR>" & "<BR>" & _
            "Phone -410 - 555 - 6664"
            .Attachments.Add ExportDir & NewRef & "\" & "PMSCI_3543 wire request.pdf"
'            .Attachments.Add
            .Close 0
            End With
'CRTb.MoveNext
        Set MailOutLook = Nothing
'Loop

DoCmd.SetWarnings True
    Beep
    MsgBox "An email was placed in your Outlook Drafts folder."
   
End Function
0
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

 
COACHMAN99Commented:
There appear to be three issues. (table quotes, .to line and commented LOOP.

see modified code:

Addressee = DLookup("EmailAddress", "CRTb", "e-mail = 'y'")
ContactEM = DLookup("L_Name", "tblEmailAddresses")
FirstnameC = DLookup("F_Name", "tblEmailAddresses")


Do While Not CRTb.EOF
            Set appOutLook = CreateObject("Outlook.Application")
            Set MailOutLook = appOutLook.CreateItem(olMailItem)
            With MailOutLook
            .BodyFormat = olFormatHTML
            .To = CRTb.Fields("EmailAddress")
'            .To = DLookup("EmailAddress", "tblEmailAddresses")
            .Subject = "CI.Milestone Invoice"
            .HTMLBody = "Users,   " & "<BR>" & "<BR>" & _
            "Invoice # - " & "<BR>" & "<BR>" & _
            "Date - " & "<BR>" & "<BR>" & _
            "CI Amount - $" & "<BR>" & "<BR>" & _
            "DTD - $" & "<BR>" & "<BR>" & _
            "Total - $" & "<BR>" & "<BR>" & _
            (vbCr & vbLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Thank you.") & "<BR>" & "<BR>" & _
            "Jimmie" & "<BR>" & "<BR>" & _
            "CI Finance and Asset Reporting" & "<BR>" & "<BR>" & _
            "Phone -410 - 555 - 6664"
            .Attachments.Add ExportDir & NewRef & "\" & "PMSCI_3543 wire request.pdf"
'            .Attachments.Add
            .Close 0
            End With
'CRTb.MoveNext
        Set MailOutLook = Nothing
Loop
0
 
COACHMAN99Commented:
and a 4th issue with parameters in Set CRTb = DBEngine(0)(0).OpenRecordset("(SELECT * from tblEmailAddresses where e-mail = 'y')")

have to go to a meeting.
0
 
CFMIFinancial Systems AnalystAuthor Commented:
We're getting close:
  1)  Set CRTb = DBEngine(0)(0).OpenRecordset("(SELECT * from tblEmailAddresses where e-mail = 'y')")  is wrong.  Am not sure what's the issue but I changed it to
Set CRTb = CDb.OpenRecordset("tblEmailAddresses")
  2)  I changed the
From => .To = CRTb.EmailAddress
To =>  .To = CRTb.Fields("EmailAddress")
  3) Included "CRTb.MoveNext" and "Loop"  (that was an oops for sure).

  4) You refer to Table Quotes.  Am not sure what's the issue but I changed =>
Addressee = DLookup("EmailAddress", "CRTb.tblEmailAddresses")

That changed the paradigm so now it's working correctly.  YAY!

My next issue is to read the contents of tblEmailData and insert them into the prose of the email.  Would you please include some code for that which I can use?  I'm sure I could append data to and Set CRTb = CDb.OpenRecordset("tblEmailData") but am not sure how to either run a query for each data element or could I ditch the append concept and simply read a query to output for each data element?

See where I have - [data goes here]?
            "Invoice # - " & [data goes here] & "<BR>" & "<BR>" & _
            "Date - " & [data goes here] & "<BR>" & "<BR>" & _
            "CI Amount - $" & [data goes here] & "<BR>" & "<BR>" & _
            "DTD - $" & [data goes here] & "<BR>" & "<BR>" & _
0
 
Luke ChungPresidentCommented:
If you are open to a commercial solution, Total Access Emailer lets you embed a filtered dataset in a message so every recipient gets their own data. fmsinc.com/MicrosoftAccess/Email.asp

A free trial version is available.
0
 
COACHMAN99Commented:
I usually use code similar to the following. You are using the HTML object so would need to change a few properties in my code.
cycle through your recordset and pass parameters and assign as shown. (i.e. subject, body recipient etc.)


Function SendEmail(RecipEmail As String, Subject As String, BBody As String, cc1 As String) As Boolean
  On Error GoTo err_SendEmail
  Dim olApp As Outlook.Application
  Dim oItem As Outlook.MailItem
  Dim tInterval As Integer, signature As String
  If RecipEmail <> "" Then
    SendEmail = False
    Set olApp = CreateObject("Outlook.Application")
    Set oItem = olApp.CreateItem(olMailItem)
    With oItem
      .To = RecipEmail & IIf(cc1 <> "", "; " & cc1, "")
      .Display   'to get signature for later use
      signature = Nz(DLookup("CurricCoordSignature", "tblPrograms_LOOKUP", "Prog_Num=" & Nz(Forms("frmMain").cboProgram, 0)), 0) '.Body
      .Subject = Subject
      .Body = BBody & vbCr & vbCr & signature
    End With
    If Nz(gAttach1, "") <> "" Then oItem.Attachments.Add (cAttachmentPath & gAttach1)
    oItem.Display

  End If
  SendEmail = True
exit_SendEmail:
  On Error Resume Next
  Set olApp = Nothing
  Set oItem = Nothing
  Exit Function
err_SendEmail:
  MsgBox "Error " & Err.Number & ", " & Err.Description & " Occurred in SendEmail after " & ErrorLine
  Resume exit_SendEmail
End Function
0
 
CFMIFinancial Systems AnalystAuthor Commented:
(I cannot do commercial solutions.)  

COACHMAN99,
I'm reading your code. It looks cool but I don't fully understand.  Please help me to identify what 'RecipEmail' looks like; what 'cc1' looks like; what 'BBody' looks like; what 'tblPrograms_LOOKUP' looks like; and what frmMain.cboProgram' looks like.  I think the 'BBody' is especially what I might be looking for.

I'm also intrigued by
'If Nz(gAttach1, "") <> "" Then oItem.Attachments.Add (cAttachmentPath & gAttach1)
    oItem.Display'
Please explain.
0
 
CFMIFinancial Systems AnalystAuthor Commented:
I am still learning and - as noted cannot use commercial solutions.  I'll close this, review alternatives, and move on.  Thanks very much for all your input.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.