Greetings,
I need to create and send outlook emails from criteria in an Excel worksheet. Actually 2 worksheets in the same workbook. but one at a time just to get things working.
I need either a BCC or send to another email address. Hard coded or from a range in the worksheet.
The subjects and body are custom for each email. The recipient has to know and reply to each employee if access is still allowed. I have set up a line for voting buttons, but the code stops there looking for an object.
I have 2 sub() routines one drives the other so I can loop through as many worksheets as necessary.
The idea is to start at row 2 and create emails until column A no longer has email addresses. Including the subject, body etc.
The time saved will be great as when in use the anticipated number of emails will be near 700 as of today. That is just too much to create individually.
The code is below and I have commented in the code with specific questions/issues.
Any guidance will be greatly appreciated.
I didn't see where I could upload the file. would be much easier. sorry.
Jerry
Table: sheet 1; ( there are formulas to create the subject and body. the body has leading and trailing quotes when copied and pasted. Row 1 is the table header.l
Code:
Sub compliance_email()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
' Dim strVotingButtons As Object doesn't help. and MailItem.VotingOptions
' generates an expected end error when used
' Dim strSubj As String I don't know if I need this.
' Dim strBody As String I don't know if I need this.
' Any other variables that need to be defined?
' When this runs I get an Object Required error
' Application.ScreenUpdating = False not needed right now
Sheets("Test sheet 1").Select
Call Email_create_send
' I have test sheet 2 out until I get test sheet 1 working
' Sheets("Test sheet 2").Select
'Call Email_create_send
Sheets("Controls").Select
Range("A1").Select
' Application.ScreenUpdating = True not needed right now.
End Sub
Sub Email_create_send()
' On Error GoTo dbg turned off to help trouble shoot
' Create a new Outlook object
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1)) 'is this row 1? if so then should 1 = 2?
' Create a new item (email) in Outlook
Set olMailItm = olApp.CreateItem(0)
strSubj = ""
strBody = ""
useremail = Cells(iCounter, 1).Value 'to email
' how do I get the subject and body into each email
strSubj = Cells(iCounter, 6).Value 'email subject
strBody = Cells(iCounter, 7).Value 'email message
olMailItm.To = useremail
olMailItm.BCC = "cuyahogariverspeeder@gmail.com" 'bcc is a range in the spread sheet. can I make the
' range work for either bcc or reply recipients.add below? That would make it easier
' to change addresses. If not hard code is fine.
' ReplyRecipients.Add ("cuyahogariverspeeder@gmail.com")future to dedicated mail box and this
' would elimante the BCC, yes?
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
' 1 – text format of an email, 2 - HTML format
olMailItm.Body = strBody
' set voting buttons to Approve, Reject.
' generating the object error here it seems
MailItem.VotingOptions = strVotingButtons
strVotingButtons = "Approve;Reject"
olMailItm.Send
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
' dbg: turned off to help trouble shoot
' Display errors, if any
' If Err.Description <> "" Then MsgBox Err.Description
End Sub
I need to create and send outlook emails from criteria in an Excel worksheet. Actually 2 worksheets in the same workbook. but one at a time just to get things working.
I need either a BCC or send to another email address. Hard coded or from a range in the worksheet.
The subjects and body are custom for each email. The recipient has to know and reply to each employee if access is still allowed. I have set up a line for voting buttons, but the code stops there looking for an object.
I have 2 sub() routines one drives the other so I can loop through as many worksheets as necessary.
The idea is to start at row 2 and create emails until column A no longer has email addresses. Including the subject, body etc.
The time saved will be great as when in use the anticipated number of emails will be near 700 as of today. That is just too much to create individually.
The code is below and I have commented in the code with specific questions/issues.
Any guidance will be greatly appreciated.
I didn't see where I could upload the file. would be much easier. sorry.
Jerry
Table: sheet 1; ( there are formulas to create the subject and body. the body has leading and trailing quotes when copied and pasted. Row 1 is the table header.l
| A | B | C | D | E | F | G | H |
| Managers Email To: | Mgr Fname | Employee | Employee ID | Mgr Name | Subject: | Message: | Employee F Name |
| jpsanicky@gmail.com | Tommie | Millicent Sipes | 123456 | Moore, Tommie | Employee Application Access Audit: Millicent Sipes | Dear Tommie, Using the Voting Buttons please approve or reject access for Millicent Sipes, EID 123456 to the Application. We show Millicent to be on a leave of absence. Please respond by Wed. Apr. 1. 2020. Failure to do so will result in Millicent's access to the EUTOA being revoked. | Millicent |
| jpsanicky@gmail.com | Kenton | Gaynelle Thayer | 123457 | Newton, Kenton | Employee Application Access Audit: Gaynelle Thayer | Dear Kenton, Using the Voting Buttons please approve or reject access for Gaynelle Thayer, EID 123457 to the Application. We show Gaynelle to be on a leave of absence. Please respond by Wed. Apr. 1. 2020. Failure to do so will result in Gaynelle's access to the EUTOA being revoked. | Gaynelle |
| jpsanicky@gmail.com | Merle | Treva Dowling | 123458 | Mclaughlin, Merle | Employee Application Access Audit: Treva Dowling | Dear Merle, Using the Voting Buttons please approve or reject access for Treva Dowling, EID 123458 to the Application. We show Treva to be on a leave of absence. Please respond by Wed. Apr. 1. 2020. Failure to do so will result in Treva's access to the EUTOA being revoked. | Treva |
| jpsanicky@gmail.com | Angie | Suzie Redding | 123459 | Acevedo, Angie | Employee Application Access Audit: Suzie Redding | Dear Angie, Using the Voting Buttons please approve or reject access for Suzie Redding, EID 123459 to the Application. We show Suzie to be on a leave of absence. Please respond by Wed. Apr. 1. 2020. Failure to do so will result in Suzie's access to the EUTOA being revoked. | Suzie |
| jpsanicky@gmail.com | Edna | Page Pride | 123460 | Parsons, Edna | Employee Application Access Audit: Page Pride | Dear Edna, Using the Voting Buttons please approve or reject access for Page Pride, EID 123460 to the Application. We show Page to be on a leave of absence. Please respond by Wed. Apr. 1. 2020. Failure to do so will result in Page's access to the EUTOA being revoked. | Page |
Code:
Sub compliance_email()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
' Dim strVotingButtons As Object doesn't help. and MailItem.VotingOptions
' generates an expected end error when used
' Dim strSubj As String I don't know if I need this.
' Dim strBody As String I don't know if I need this.
' Any other variables that need to be defined?
' When this runs I get an Object Required error
' Application.ScreenUpdating = False not needed right now
Sheets("Test sheet 1").Select
Call Email_create_send
' I have test sheet 2 out until I get test sheet 1 working
' Sheets("Test sheet 2").Select
'Call Email_create_send
Sheets("Controls").Select
Range("A1").Select
' Application.ScreenUpdating = True not needed right now.
End Sub
Sub Email_create_send()
' On Error GoTo dbg turned off to help trouble shoot
' Create a new Outlook object
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1)) 'is this row 1? if so then should 1 = 2?
' Create a new item (email) in Outlook
Set olMailItm = olApp.CreateItem(0)
strSubj = ""
strBody = ""
useremail = Cells(iCounter, 1).Value 'to email
' how do I get the subject and body into each email
strSubj = Cells(iCounter, 6).Value 'email subject
strBody = Cells(iCounter, 7).Value 'email message
olMailItm.To = useremail
olMailItm.BCC = "cuyahogariverspeeder@gmail.com" 'bcc is a range in the spread sheet. can I make the
' range work for either bcc or reply recipients.add below? That would make it easier
' to change addresses. If not hard code is fine.
' ReplyRecipients.Add ("cuyahogariverspeeder@gmail.com")future to dedicated mail box and this
' would elimante the BCC, yes?
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
' 1 – text format of an email, 2 - HTML format
olMailItm.Body = strBody
' set voting buttons to Approve, Reject.
' generating the object error here it seems
MailItem.VotingOptions = strVotingButtons
strVotingButtons = "Approve;Reject"
olMailItm.Send
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
' dbg: turned off to help trouble shoot
' Display errors, if any
' If Err.Description <> "" Then MsgBox Err.Description
End Sub
