Log In
Register
Home
December 4, 2021
Offline
I need help creating a macro that will send emails. This will be generated from an Excel File and there is an Outlook OFT file that will be used as the template for ALL the emails. Although it would be nice to personalize each email with the first name, that is not a dealbreaker. So second requirement is the Excel sheet. Each row will be 1 e-mail, so the email address, cc and file attachments are only relevant to that single row. The Manager Name in Column A, is for my records to keep all the data straight.
This code below was for a similar purpose. There were no attachments used, and there was a requirement of a loop for each 500 records. Sheet 1 is the main sheet which contains the path to the OFT file (cell E9), and the macro button. Sheet 2 contains the following columns. And like I said, I would like a Date/Time stamp to appear in Column E when the email is sent (if possible). Thanks in advance!!!!!
A - Manager's Name
B - Manager's Email
C - CC Emails
D - File to Attach
And then if possible (not a dealbreaker) that Column E could be a date/time stamp of when the email was sent.
<Code>
Option Explicit
Sub Email_ChangeNotification()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailTo As String
Dim LastRw As Long
Dim i As Integer
Dim SentOnBehalfOfName As String
' Set Outlook object.
Set OutApp = CreateObject("Outlook.Application")
LastRw = Range("B" & Rows.Count).End(xlUp).Row
' Loop of 500 email addresses
For i = 2 To LastRw Step 500
' Sheet where email List is located
EmailTo = Join(Application.Transpose(Sheet2.Range("B" & i & ":B" & WorksheetFunction.Min(i + 499, LastRw)).Value), ";")
' Change to path of OFT Template
Set OutMail = OutApp.CreateItemFromTemplate(Sheet1.Range("E9").Select)
.To = EmailTo ' Column B of Sheet # listed above
.CC = ""
.BCC = ""
.Display
'.send
End With
Next i
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
</Code>
Trusted Members
Moderators
November 1, 2018
Offline
Untested, obviously, but something like this:
Option Explicit
Sub Email_ChangeNotification()
' Sheet where email template (oft) location is specified
Dim EmailTemplate As String
EmailTemplate = Sheet1.Range("E9").Value
' Set Outlook object.
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim dataSheet As Worksheet
Set dataSheet = Sheet2
With dataSheet
Dim LastRw As Long
LastRw = .Range("B" & .Rows.Count).End(xlUp).Row
' Loop all rows
Dim rw As Long
For rw = 2 To LastRw
Dim OutMail As Object
Set OutMail = OutApp.CreateItemFromTemplate(EmailTemplate)
With OutMail
.To = dataSheet.Cells(rw, "B").Value
.CC = dataSheet.Cells(rw, "C").Value
If Len(dataSheet.Cells(rw, "D").Value) > 0 Then .attachments.Add dataSheet.Cells(rw, "D").Value
dataSheet.Cells(rw, "E").Value = Now()
.display
End With
Next rw
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
December 4, 2021
Offline
@Velouria,
I am working on 1/2 cup of coffee! LOL I wanted to confirm that Column D for my file name, it should include the Path & file name, correct? All these files would be in the same folder. But I wanted to confirm, as I did not see anywhere within the code for me to indicate the path of the attachments. That was my bad.
Trusted Members
Moderators
November 1, 2018
Offline
As the code is written, yes, but it could easily be amended to get the path from somewhere else if it's the same for all attachments.
I forgot to mention that the code simply timestamps the cell when the email is created, not when it is sent. It is nigh on impossible to reliably achieve the latter.
December 4, 2021
Offline
@Velouria,
That is sufficient. The Date/Timestamp is to show primarily that the email WAS sent. and if the time is off slightly due to the difference in time as to when the email is created vs sent does not matter so much.
I am not yet ready to test the emails. I am still splitting my data files (almost done). Plus I have multiple other projects. But I do see this as a solution I can use for multiple projects.
What if the path for the attachments was listed on Sheet1.Range("E5")? Can you modify the code for that? This is being built for someone else to use, so I would rather not have to hold their hand during the process. So it would appear on the same sheet that the OFT path is listed on, a few cells above that.
Trusted Members
Moderators
November 1, 2018
Offline
My point was merely that the user might not actually send the email, but it would still be flagged with the created date and time.
You could amend the code to:
Sub Email_ChangeNotification()
' Sheet where email template (oft) location is specified
Dim EmailTemplate As String
EmailTemplate = Sheet1.Range("E9").Value
Dim attachmentPath As String
attachmentPath = Sheet1.Range("E5").Value
If Right$(attachmentPath, 1) <> "\" Then attachmentPath = attachmentPath & "\"
' Set Outlook object.
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim dataSheet As Worksheet
Set dataSheet = Sheet2
With dataSheet
Dim LastRw As Long
LastRw = .Range("B" & .Rows.Count).End(xlUp).Row
' Loop all rows
Dim rw As Long
For rw = 2 To LastRw
Dim OutMail As Object
Set OutMail = OutApp.CreateItemFromTemplate(EmailTemplate)
With OutMail
.To = dataSheet.Cells(rw, "B").Value
.CC = dataSheet.Cells(rw, "C").Value
If Len(dataSheet.Cells(rw, "D").Value) > 0 Then .attachments.Add attachmentPath & dataSheet.Cells(rw, "D").Value
dataSheet.Cells(rw, "E").Value = Now()
.display
End With
Next rw
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
December 4, 2021
Offline
@Velouria,
That makes perfect sense. I appreciate the help with the revision for the path of the attachment file. And to avoid confusion, I have changed the header in column E from "Date/Time Sent" to "Date/Time Created". I think that should be obvious. I finished splitting my files tonight. So tomorrow I will do a test run with the Project Manager & Lead to make sure this macro works as expected. Thanks so very much for all your help!
1 Guest(s)
