By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,882 Members | 2,453 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,882 IT Pros & Developers. It's quick & easy.

Send email with attachments using VBA

P: 11
I have been working in copy and paste for years and would love to automate the bi-monthly invoice summary e-mails that I send to my customers!

My Access 2013 database creates summaries for customers exported to an excel spreadsheet.
With the help of Ron De Bruin code, I was able to have excel split the worksheet into separate workbooks.

Back in Access, I have a parameter query that will pull a list of these customers and the path and file to their summary, like this
STID CustID ACCT APCEmail STMTAP STDATE STMTPATH
30 740 999999 hmc@123.com TRUE 05-Jan-19 C:\User\Summaries\EMAIL\999999.xlsx

I'm not sure where to begin!!
Do I start with DAO to set database and recordset, then loop through with MoveFirst & DoUntil, build the e-mail name, subject and message with string and SendObject?
Jan 5 '19 #1
Share this Question
Share on Google+
2 Replies


Nauticalgent
P: 92
I do something similar to what it is you're trying to do. Here is the code I use. Hopefully you can adapt it to your needs.

Expand|Select|Wrap|Line Numbers
  1.  
  2. Private Sub SendEmailPass()
  3.  
  4.     Dim db As DAO.Database
  5.     Dim rs As DAO.Recordset
  6.     Dim rs1 As DAO.Recordset
  7.     Dim qdf As DAO.QueryDef
  8.     Dim strTo As String
  9.     Dim strCC As String
  10.     Dim strSubject As String
  11.     Dim strBody As String
  12.     Dim strMaintActy As String
  13.     Dim strShopCode As String
  14.     Dim strShipName As String
  15.     Dim intPassCode As Integer
  16.     Dim strPassCode As String
  17.     Dim intWC As Integer
  18.     Dim outApp As Outlook.Application
  19.     Dim outMail As Outlook.MailItem
  20.     Dim intPE As Integer
  21.     Dim intCSPE As Integer
  22.  
  23.     On Error Resume Next
  24.     Set outApp = GetObject(, "Outlook.Application")
  25.     On Error GoTo 0
  26.  
  27.     If outApp Is Nothing Then
  28.         Set outApp = CreateObject("Outlook.Application")
  29.     End If
  30.  
  31.     intWC = Forms![frmJobPasses]![frmAssignments].Form![AssignActy]
  32.     intPassCode = Nz(Me![frmAssignments].Form![AssignPassCode], 0)
  33.     intPE = Nz(Forms![frmJobPasses]![sfrmUnitInfo].Form![cboPE], 0)
  34.     intCSPE = Nz(Forms![frmJobPasses]![sfrmUnitInfo].Form![cboCSPE], 0)
  35.     strPassCode = Nz(DLookup("PassDescrip", "tblPassCodes", "PassCodeID = " & intPassCode))
  36.     strShopCode = Nz(DLookup("ShopCode", "tblMaintActyUnits", "UnitID = " & intWC))
  37.     strMaintActy = Nz(DLookup("Activity", "tblMaintActyUnits", "UnitID = " & intWC))
  38.     strShipName = Nz(DLookup("ShipFullName", "qryShipName", "UnitID = " & Me.UnitID))
  39.  
  40.     Set db = CurrentDb
  41.     Set qdf = db.QueryDefs("qrySelectEmail")
  42.     Set rs1 = db.OpenRecordset("qrySelectCC")
  43.  
  44.     strTo = vbNullString
  45.     With qdf
  46.         .Parameters("intUnitID") = intWC
  47.         Set rs = .OpenRecordset
  48.         rs.MoveFirst
  49.         Do Until rs.EOF
  50.             strTo = strTo & rs.Fields(0) & ";" & vbCrLf
  51.             rs.MoveNext
  52.         Loop
  53.     End With
  54.     strTo = strTo & GetPE(intPE, intCSPE)
  55.  
  56.     With rs1
  57.         strCC = vbNullString
  58.         rs1.MoveFirst
  59.         Do Until rs1.EOF
  60.             strCC = strCC & .Fields(0) & ";" & vbCrLf
  61.             rs1.MoveNext
  62.         Loop
  63.         strCC = strCC & ";" & Me.UnitPOC_Email
  64.     End With
  65.  
  66.  
  67.     strSubject = "** EMAIL PASS ** FROM FDRMC TO " & strMaintActy & " - " & strShopCode _
  68.                 & " FOR " & strShipName & " / " & Me.JobEquip & " / " & Replace(Me.JobCat, "C", "CAT") _
  69.                 & " / CASREP: " & Me.JobNum & " / DTG: " & Me.JobDTG
  70.  
  71.     strBody = strMaintActy & ": Please reply to all and confirm acceptance of support and assigned technician," _
  72.             & " and include the FDRMC Naples CDO <mailto:YourEmail@YourDomain.com > on all related email traffic." & vbCrLf _
  73.             & vbCrLf _
  74.             & "1. Equipment: " & Me.JobEquip & vbCrLf _
  75.             & "2. For detailed information see DTG: " & Me.JobDTG & vbCrLf _
  76.             & "3. Job Number: " & Me.JCN & vbCrLf _
  77.             & "4. Requested Action: " & Me.JobAction & vbCrLf _
  78.             & "5. Reason for pass: " & strPassCode & vbCrLf _
  79.             & "6. Ship's POC information: " & Me.UnitPOC & " / " & Me.UnitPOC_Email & vbCrLf _
  80.             & "7. Request CC <YourEmail@YourDomain.com> on all correspondence for tracking purposes."
  81.     strBody = strBody & vbCrLf _
  82.             & vbCrLf _
  83.             & "Very Respectfully,"
  84.  
  85.  
  86.     Set outMail = outApp.CreateItem(olMailItem)
  87.     With outMail
  88.         .To = strTo
  89.         .CC = strCC
  90.         .Subject = strSubject
  91.         .Body = strBody
  92.         .Display
  93.  
  94.     End With
  95.  
  96. exit_handler:
  97.     rs.Close
  98.     rs1.Close
  99.     Set rs = Nothing
  100.     Set db = Nothing
  101.     Set rs = Nothing
  102.     Set outMail = Nothing
  103.     Set outApp = Nothing
  104.  
  105. End Sub
  106.  
Jan 5 '19 #2

twinnyfo
Expert Mod 2.5K+
P: 3,284
If you are using Outlook, as very helpful article is here.

Yes, the basics are this:

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Private Sub SendEmail_Click()
  5. On Error GoTo EH
  6.     Dim db              As DAO.Database
  7.     Dim rst             As DAO.Recordset
  8.     Dim strSendTo       As String
  9.     Dim strSubject      As String
  10.     Dim strEMailBody    As String
  11.     Dim strCCLine       As String
  12.     Dim strBCCLine      As String
  13.     Dim strOnBehalfOf   As String
  14.     Dim strAtchs        As String
  15.  
  16.     Set db = CurrentDb()
  17.     Set rst = db.OpenRecordset("YourQuery")
  18.     With rst
  19.         If Not (.BOF And .EOF) Then
  20.             Call .MoveFirst
  21.             Do While Not .EOF
  22.                 strSendTo = !EmailAddress
  23.                 '...
  24.                 'build the rest of your e-mail
  25.                 '...
  26.  
  27.                 'Generate and Display the E-Mail
  28.                 Call SendAnEMail(olSendTo:=strSendTo, _
  29.                                  olSubject:=strSubject, _
  30.                                  olEMailBody:=strEMailBody, _
  31.                                  olDisplay:=True, _
  32.                                  olCCLine:=strCCLine, _
  33.                                  olBCCLine:=strBCCLine, _
  34.                                  olOnBehalfOf:=strOnBehalfOf, _
  35.                                  olAtchs:=strAtchs, _
  36.                                  SendAsHTML:=False)
  37.  
  38.                 Call .MoveNext
  39.             Loop
  40.         End If
  41.         Call .Close
  42.     End With
  43.     db.Close
  44.     Set rst = Nothing
  45.     Set db = Nothing
  46.  
  47. EH:
  48.     Set rst = Nothing
  49.     Set db = Nothing
  50.     Call MsgBox(Prompt:="There was an Error", _
  51.                 Buttons:=vbOKOnly, _
  52.                 Title:="Call teh DBA!")
  53. End Sub
Hope this hepps!
Jan 7 '19 #3

Post your reply

Sign in to post your reply or Sign up for a free account.