GENERATE EMAIL BASED ON EXPIRATION DATE W/ DETAILS ON EMAIL BODY

JuicyMusic

Board Regular
Joined
Jun 13, 2020
Messages
210
Office Version
  1. 365
Platform
  1. Windows
Hello,

I found a code in MREXCEL that works very well but I need to tweak it a bit but I am not able to do so.
This code generates an email based on 2 different types of text in column L: "Expiring Soon" and "Expired".

1) This code inserts the text in Column A and puts it in the email body but I would like the data from Column A to F to be inserted, including the header rows.
2) I would like this code to list the rows vertically. One below the other. Example: Row 2 from Column a thru F, then Row 3 from A thru F, and so on.
3) I would like the format in the rows from Column A to F to be inserted as well. Borders and etc. Whatever formatting is there.
4) Is there a way for the email(s) to generate (.Display) as soon as the spreadsheet is open?

Below is the code that I am referring to. I've also uploaded an image of my spreadsheet. I can't wait to see how this code gets adjusted. I am able to adjust some things, but not this time.
Thank you so much in advance. I appreciate your efforts. Juicy,



VBA Code:
Private Sub Workbook_Open()
Dim Instrument1 As String
Dim Instrument2 As String

Dim ws As Worksheet
Dim Status As String
Set ws = Sheets("Renewal Log")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
' MsgBox "This code ran at Excel start!"
' On Error Resume Next
' If Target.Cells.Count > 1 Then Exit Sub
counter1 = 0
counter2 = 0
On Error Resume Next
For i = 2 To lr
  Status = ws.Range("L" & i).Value
    If Status = "Expiring Soon" Then
Instrument1 = Instrument1 & ws.Range("A" & i).Value & ", "
counter1 = counter1 + 1
End If
If Status = "Expired" Then
Instrument2 = Instrument2 & ws.Range("A" & i).Value & ", "
counter2 = counter2 + 1
End If


Next i
If counter1 > 0 And counter1 = 1 Then Mail_Expiring_Soon_Outlook Left(Instrument1, Len(Instrument1) - 2)
If counter1 > 0 And counter1 > 1 Then Mail_Expiring_Soon_Outlook Left(Instrument1, Len(Instrument1) - 1)
If counter2 > 0 And counter2 = 1 Then Mail_Expired_Outlook Left(Instrument2, Len(Instrument2) - 2)
If counter2 > 0 And counter2 > 1 Then Mail_Expired_Outlook Left(Instrument2, Len(Instrument2) - 1)
End Sub
Sub Mail_Expiring_Soon_Outlook(Instrument1 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Attention" & vbNewLine & vbNewLine & _
"The " & Instrument1 & " renewal is due soon." & vbNewLine & vbNewLine & _
"Please arrange for review or payment."
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Renewal date is approaching"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Mail_Expired_Outlook(Instrument2 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Warning!" & vbNewLine & vbNewLine & _
"The " & Instrument2 & " Registration/Coverage/License has expired." & vbNewLine & vbNewLine & _
"Please arrange for review or payment."
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Warning! Registration/Coverage/License has Expired"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
 

Attachments

  • Expiration worksheet.PNG
    Expiration worksheet.PNG
    37.7 KB · Views: 25

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Hello, any VBA Guru's, I waited a few days before "bumping" my post. Please let me know if I need to provide more clarity. I will be happy to do so immediately.
Thank you so much!!!!! Juicy
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top