Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 06-14-2019, 10:37 AM   #1
IgnoranceIsBliss
Newly Registered User
 
Join Date: Jun 2019
Posts: 33
Thanks: 0
Thanked 1 Time in 1 Post
IgnoranceIsBliss is on a distinguished road
VBA To Create Email

Hi all - I have a Customers table that has roughly 4,000 rows in it (and growing). I am attempting to automate some things that are currently manually done.

Below is the process..
1) Query Table1 For all customers whose ContactFUTimeFrame is current month
2) Create Two groups of the current month customers
a. Group 1 = New Sale
b. Group 2 = Follow-Up
3) Capture the Contact Name, Contact Email and Folder Location for the Customer
4) Create an email Draft

I have put together this syntax, which debugs perfect, but when I attempt to press the button and hopefully have Drafts created, I get no draft created and no errors displayed.

Can someone help me here with what is going wrong with my code?

Code:
Option Compare Database
Private Sub Command2_Click()
Dim currMonth As String
Dim contact As String
Dim contactEmail As String
Dim customerFolder As String
Dim emailBody As String
Dim emailSubject As String
Dim rsNS As DAO.Recordset
Dim rsFU As DAO.Recordset
Dim nsAll As Variant
Dim fuAll As Variant
Dim ns As Variant
Dim fu As Variant

'Get current month
currMonth = MonthName(Month(Now), True)

'Create array to house New Sale for current month
Set rsNS = CurrentDb.OpenRecordset("Select ClientName FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'New Sale'")
rsNS.MoveFirst
rsNS.MoveLast
nsAll = rsNS.GetRows(rsNS.RecordCount)

'Create Array to house Follow Up for current month
Set rsFU = CurrentDb.OpenRecordset("Select ClientName FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'Follow-Up'")
rsFU.MoveFirst
rsFU.MoveLast
fuAll = rsFU.GetRows(rsFU.RecordCount)

'Iterate the array
For Each ns In nsAll
    'Grab the contact Name
    contact = DLookup("ClientContactName", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Grabbing Customer Folder
    customerFolder = DLookup("LocalCustomerFolder", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Grabbing Customer Email
    contactEmail = DLookup("ClientContactEmail", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Check if Customer Name field has one name or multiple
    ValidateInput (contact)
    
    'If Not All take first name only
    If contact <> "All" Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    emailSubject = Year(Date) & " New Sale Information - " & CStr(ns)
    
    'Creating the email draft
    CreateEmail emailSubject, emailBody, customerFolder, contactEmail
Next


'Iterate the array
For Each fu In fuAll
    'Grab the contact Name
    contact = DLookup("ClientContactName", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Grabbing Customer Folder
    customerFolder = DLookup("LocalCustomerFolder", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Grabbing Customer Email
    contactEmail = DLookup("ClientContactEmail", "Table1", "ClientName = '" & CStr(ns) & "'")
    
    'Check if Customer Name field has one name or multiple
    ValidateInput (contact)
    
    'If Not All take first name only
    If contact <> "All" Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    emailSubject = Year(Date) & " Follow-Up Email - " & CStr(ns)
    
    'Creating the email draft
    CreateEmail emailSubject, emailBody, customerFolder, contactEmail
Next


End Sub
Private Function CreateEmail(emailSubject As String, emailBody As String, customerFolder As String, contactEmail As String)
    Set appOutLook = CreateObject("Outlook.Application")
    Set MailOutLook = appOutLook.CreateItem(olMailItem)
    
    With MailOutLook
        .BodyFormat = olFormatHTML
        .To = contactEmail
        .Subject = emailSubject
        .HTMLBody = emailBody
        .Save
    End With
End Function
Private Function ValidateInput(cn As String)
If InStr(cn, ",") = 0 Then
    contactName = cn
Else
    contactName = "All"
End If
End Function

IgnoranceIsBliss is offline   Reply With Quote
Old 06-14-2019, 10:43 AM   #2
June7
Newly Registered User
 
June7's Avatar
 
Join Date: Mar 2014
Posts: 1,959
Thanks: 0
Thanked 463 Times in 459 Posts
June7 will become famous soon enough June7 will become famous soon enough
Re: VBA To Create Email

You say code has no compile errors but have you stepped through code?

ValidateInput function is not needed.

Your table is actually named "Table1"? Hardly informative.

Why use DLookup? Why not include those fields in the recordset?

People name parts really should be saved in separate fields. It is easier to concatenate than split apart.

This can be accomplished without arrays.

Use .Close to automatically save into Draft folder.

You want individual email to each contact? Or a single email to multiple addresses?

Consider:

Code:
Option Compare Database
Option Explicit

Private Sub Command2_Click()
Dim currMonth As String
'Get current month
currMonth = MonthName(Month(Now), True)
CreateEmail "Select ClientName, ClientContactName, LocalCustomerFolder, ClientContactEmail FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'New Sale'"
CreateEmail "Select ClientName, ClientContactName, LocalCustomerFolder, ClientContactEmail FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'Follow-Up'"
End Sub

Private Sub CreateEmail(strRS As String)
Dim contact As String
Dim emailBody As String
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim rs As DAO.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
Set rs = CurrentDb.OpenRecordset(strRS)
Do While Not rs.EOF
    'Grab the contact Name
    contact = rs!ClientContactName
    If InStr(contact, ",") = 0 Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    With MailOutlook
        .BodyFormat = olFormatHTML
        .To = rs!ClientContactEmail
        .Subject = Year(Date) & " New Sale Information - " & rs!ClientName
        .HTMLBody = emailBody
        .Save
        .Close olSave
    End With
Loop
End Sub
__________________
Attach File Manager is below Advanced editor window, click Go Advanced below Quick Reply window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
DEBUG! DEBUG! DEBUG!
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.

Last edited by June7; 06-14-2019 at 12:11 PM.
June7 is offline   Reply With Quote
Old 06-14-2019, 10:57 AM   #3
CJ_London
Super Moderator
 
Join Date: Feb 2013
Location: UK
Posts: 10,905
Thanks: 40
Thanked 3,538 Times in 3,419 Posts
CJ_London is just really nice CJ_London is just really nice CJ_London is just really nice CJ_London is just really nice CJ_London is just really nice
Re: VBA To Create Email

try putting option explicit under option compare database - think you will then find plenty of compilation errors.

suspect you are getting contact and contactname mixed up since I cannot see any reason for calling your validateinput function

Also agree with June - step through the code and check values as you go

__________________
CJ_London
_______________________
A little thanks goes a long way. If you have found this post useful, please tick the thanks button
CJ_London is offline   Reply With Quote
Old 06-29-2019, 08:49 AM   #4
IgnoranceIsBliss
Newly Registered User
 
Join Date: Jun 2019
Posts: 33
Thanks: 0
Thanked 1 Time in 1 Post
IgnoranceIsBliss is on a distinguished road
Re: VBA To Create Email

Quote:
Originally Posted by June7 View Post
You say code has no compile errors but have you stepped through code?

ValidateInput function is not needed.

Your table is actually named "Table1"? Hardly informative.

Why use DLookup? Why not include those fields in the recordset?

People name parts really should be saved in separate fields. It is easier to concatenate than split apart.

This can be accomplished without arrays.

Use .Close to automatically save into Draft folder.

You want individual email to each contact? Or a single email to multiple addresses?

Consider:

Code:
Option Compare Database
Option Explicit

Private Sub Command2_Click()
Dim currMonth As String
'Get current month
currMonth = MonthName(Month(Now), True)
CreateEmail "Select ClientName, ClientContactName, LocalCustomerFolder, ClientContactEmail FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'New Sale'"
CreateEmail "Select ClientName, ClientContactName, LocalCustomerFolder, ClientContactEmail FROM Table1 WHERE Mid(ContactFUTimeFrame, InStrRev(ContactFUTimeFrame, ' ') + 1) = " & currMonth & " And ContactType = 'Follow-Up'"
End Sub

Private Sub CreateEmail(strRS As String)
Dim contact As String
Dim emailBody As String
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim rs As DAO.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
Set rs = CurrentDb.OpenRecordset(strRS)
Do While Not rs.EOF
    'Grab the contact Name
    contact = rs!ClientContactName
    If InStr(contact, ",") = 0 Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    With MailOutlook
        .BodyFormat = olFormatHTML
        .To = rs!ClientContactEmail
        .Subject = Year(Date) & " New Sale Information - " & rs!ClientName
        .HTMLBody = emailBody
        .Save
        .Close olSave
    End With
Loop
End Sub
Hi - I like your approach much better! I finally have had a moment to test the code, but I am getting a debug error of on the Set rs line....
Run-time error '3061':

Too few parameters. Expected 1

And this is the syntax I am using (with actual field names since I know realize that matters)....
Code:
Function Test()
Dim currMonth As String
currMonth = MonthName(Month(Now), True)
CreateEmail "Select [_Parent Info].CompanyName, [_Parent Info].[Main Contact], [_LocalData].CF FROM [_Parent Info] Inner Join [_LocalData] ON [_Parent Info].CompanyName = [_LocalData].Company Where Mid([Status], InStrRev([Status], ' ') + 1) = " & currMonth & "
End Test

Sub CreateEmail (strRS As String)
Dim contact As String
Dim emailBody As String
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim rs As DAO.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
Set rs = CurrentDb.OpenRecordset(strRS)
End Sub
IgnoranceIsBliss is offline   Reply With Quote
Old 06-29-2019, 09:03 AM   #5
Gasman
Enthusiastic Amateur
 
Join Date: Sep 2011
Location: Swansea, South Wales,UK
Posts: 3,671
Thanks: 398
Thanked 636 Times in 617 Posts
Gasman has a spectacular aura about Gasman has a spectacular aura about Gasman has a spectacular aura about
Re: VBA To Create Email

Debug.Print strRS and see what that produces.?
__________________
Access novice. Sometimes trying to give something back.
Access 2007


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Gasman is online now   Reply With Quote
Old 06-29-2019, 09:17 AM   #6
IgnoranceIsBliss
Newly Registered User
 
Join Date: Jun 2019
Posts: 33
Thanks: 0
Thanked 1 Time in 1 Post
IgnoranceIsBliss is on a distinguished road
Re: VBA To Create Email

Quote:
Originally Posted by Gasman View Post
Debug.Print strRS and see what that produces.?
Ah-hah! That showed me I was missing the single quotes around the month!

Onto my last issue....
This code works, creates drafts, but it just constantly loops through the recordset never stopping. For example, If I copy/paste the strRS into a query window it produces two results. However, for some reason the code just continues to process repeatedly?
IgnoranceIsBliss is offline   Reply With Quote
Old 06-29-2019, 09:25 AM   #7
Gasman
Enthusiastic Amateur
 
Join Date: Sep 2011
Location: Swansea, South Wales,UK
Posts: 3,671
Thanks: 398
Thanked 636 Times in 617 Posts
Gasman has a spectacular aura about Gasman has a spectacular aura about Gasman has a spectacular aura about
Re: VBA To Create Email

You need to show the code?
From what you have posted it would just create a blank email.?

Most likely you are not checking for .EOF or not issuing a .MoveNext if you are?

Why not look at what June7 has posted?

Edit: Ah, there is a .MoveNext missed from there?

Code:
Do While Not rs.EOF
    'Grab the contact Name
    contact = rs!ClientContactName
    If InStr(contact, ",") = 0 Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    With MailOutlook
        .BodyFormat = olFormatHTML
        .To = rs!ClientContactEmail
        .Subject = Year(Date) & " New Sale Information - " & rs!ClientName
        .HTMLBody = emailBody
        .Save
        .Close olSave
    End With
    rs.MoveNext
Loop
HTH

__________________
Access novice. Sometimes trying to give something back.
Access 2007


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.

Last edited by Gasman; 06-29-2019 at 10:04 PM.
Gasman is online now   Reply With Quote
Old 06-29-2019, 09:27 AM   #8
IgnoranceIsBliss
Newly Registered User
 
Join Date: Jun 2019
Posts: 33
Thanks: 0
Thanked 1 Time in 1 Post
IgnoranceIsBliss is on a distinguished road
Re: VBA To Create Email

I am using the syntax June7 posted. This is the code that I have, excluding the recordset being passed in which I verified is valid.

Code:
Private Sub CreateEmail(strRS As String)
Dim contact As String
Dim emailBody As String
Dim appOutlook As Outlook.Application
Dim MailOutlook As Outlook.MailItem
Dim rs As DAO.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutlook = appOutlook.CreateItem(olMailItem)
Set rs = CurrentDb.OpenRecordset(strRS)
Do While Not rs.EOF
    'Grab the contact Name
    contact = rs!ClientContactName
    If InStr(contact, ",") = 0 Then
        contact = Left(contact, InStr(1, contact, " ") - 1)
    End If
    'Set email info
    emailBody = "<p>Hi " & contact & ",</p><p>Test test test test test test test test test test test test test.  Thanks!</p>"
    With MailOutlook
        .BodyFormat = olFormatHTML
        .To = rs!ClientContactEmail
        .Subject = Year(Date) & " New Sale Information - " & rs!ClientName
        .HTMLBody = emailBody
        .Save
        .Close olSave
    End With
Loop
End Sub
IgnoranceIsBliss is offline   Reply With Quote
The Following User Says Thank You to IgnoranceIsBliss For This Useful Post:
Uncle Gizmo (06-29-2019)
Old 06-29-2019, 09:30 AM   #9
Gasman
Enthusiastic Amateur
 
Join Date: Sep 2011
Location: Swansea, South Wales,UK
Posts: 3,671
Thanks: 398
Thanked 636 Times in 617 Posts
Gasman has a spectacular aura about Gasman has a spectacular aura about Gasman has a spectacular aura about
Re: VBA To Create Email

Yes, please reread my post, i have edited it.
__________________
Access novice. Sometimes trying to give something back.
Access 2007


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Gasman is online now   Reply With Quote
Old 06-29-2019, 09:36 AM   #10
IgnoranceIsBliss
Newly Registered User
 
Join Date: Jun 2019
Posts: 33
Thanks: 0
Thanked 1 Time in 1 Post
IgnoranceIsBliss is on a distinguished road
Re: VBA To Create Email

That resolved. Thank you kindly.
IgnoranceIsBliss is offline   Reply With Quote
Old 06-29-2019, 09:37 AM   #11
June7
Newly Registered User
 
June7's Avatar
 
Join Date: Mar 2014
Posts: 1,959
Thanks: 0
Thanked 463 Times in 459 Posts
June7 will become famous soon enough June7 will become famous soon enough
Re: VBA To Create Email

Oooops, common oversight of mine. I get caught in that infinite loop often enough, think I'd learn by now. Sorry.
__________________
Attach File Manager is below Advanced editor window, click Go Advanced below Quick Reply window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
DEBUG! DEBUG! DEBUG!
To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
June7 is offline   Reply With Quote
Old 06-29-2019, 12:51 PM   #12
Cronk
Newly Registered User
 
Join Date: Jul 2013
Posts: 2,119
Thanks: 3
Thanked 459 Times in 452 Posts
Cronk will become famous soon enough Cronk will become famous soon enough
Re: VBA To Create Email

June, me too

Cronk is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
[SOLVED] use name to create email name megatronixs Modules & VBA 6 02-18-2015 12:43 AM
Using CDO to create email upnorth Modules & VBA 5 02-17-2015 09:57 AM
Create an Email Yippiekaiaii General 1 12-13-2013 02:21 AM
Create a query, to create a report, to send in email smalls530 Reports 5 03-20-2009 09:51 AM
Create an Email? crhodus Forms 2 10-11-2004 02:43 AM




All times are GMT -8. The time now is 03:44 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World