help on the code to send emails using excel data and outlook automatically when opened

C

CLO001001

New Member
Joined
Mar 6, 2020
Messages
2
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Hi All,

I am looking for some help on the code i have managed to create.

I want to resolve below points.


The Code: (I am sure the code i created is lengthy)
-------------------------------------------------------

Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i As Long
On Error Resume Next
Set xRgDate = Application.InputBox("Due date column:", "Excel", , , , , , 8)
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Application.InputBox("email column:", "Excel", , , , , , 8)
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Application.InputBox("Property address column:", "Excel", , , , , , 8)
If xRgText Is Nothing Then Exit Sub
Set xRgText2 = Application.InputBox("First Client:", "Excel", , , , , , 8)
If xRgText2 Is Nothing Then Exit Sub
Set xRgText3 = Application.InputBox("Joint Client:", "Excel", , , , , , 8)
If xRgText3 Is Nothing Then Exit Sub
Set xRgText4 = Application.InputBox("Client Mobile:", "Excel", , , , , , 8)
If xRgText4 Is Nothing Then Exit Sub
Set xRgText5 = Application.InputBox("Client Email:", "Excel", , , , , , 8)
If xRgText5 Is Nothing Then Exit Sub
Set xRgText6 = Application.InputBox("Type Of Application:", "Excel", , , , , , 8)
If xRgText6 Is Nothing Then Exit Sub
Set xRgText7 = Application.InputBox("Product Type:", "Excel", , , , , , 8)
If xRgText7 Is Nothing Then Exit Sub
Set xRgText8 = Application.InputBox("Property Value:", "Excel", , , , , , 8)
If xRgText8 Is Nothing Then Exit Sub
Set xRgText9 = Application.InputBox("Amount:", "Excel", , , , , , 8)
If xRgText9 Is Nothing Then Exit Sub
Set xRgText10 = Application.InputBox("B Name:", "Excel", , , , , , 8)
If xRgText10 Is Nothing Then Exit Sub
Set xRgText11 = Application.InputBox("Rate:", "Excel", , , , , , 8)
If xRgText11 Is Nothing Then Exit Sub
Set xRgText12 = Application.InputBox("Sr. No:", "Excel", , , , , , 8)
If xRgText12 Is Nothing Then Exit Sub

xLastRow = xRgDate.Rows.Count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xRgText2 = xRgText2(1)
Set xRgText3 = xRgText3(1)
Set xRgText4 = xRgText4(1)
Set xRgText5 = xRgText5(1)
Set xRgText6 = xRgText6(1)
Set xRgText7 = xRgText7(1)
Set xRgText8 = xRgText8(1)
Set xRgText9 = xRgText9(1)
Set xRgText10 = xRgText10(1)
Set xRgText11 = xRgText11(1)
Set xRgText12 = xRgText12(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date <= 200 And CDate(xRgDateVal) - Date > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = "Event NOTICE - Sr.No-" & xRgText12.Offset(i - 1).Value & " : " & xRgText.Offset(i - 1).Value & " ---Event IS ON--- " & xRgDateVal
vbCrLf = "<br><br>"
xMailBody = "<HTML><BODY>"
xMailBody = xMailBody & "Hi " & vbCrLf
xMailBody = xMailBody & "Please find below details of the upcoming mortgage" & vbCrLf
xMailBody = xMailBody & "First Client Name : " & xRgText2.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Joint Client: " & xRgText3.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Client Mobile: " & xRgText4.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Client Email: " & xRgText5.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Property address : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Existing Details: " & vbCrLf
xMailBody = xMailBody & "Type Of Application: " & xRgText6.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Product Type: " & xRgText7.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Property Value: " & xRgText8.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Amount: " & xRgText9.Offset(i - 1).Value & _
xMailBody = xMailBody & "B Name: " & xRgText10.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "Rate: " & xRgText11.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "date: " & xRgDate.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "</BODY></HTML>"
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End Sub




Email i currently get with the code is as below
--------------------------------------------------

Hi

Please find below details of the upcoming event

First Client Name : CLIENT 1

Joint Client: CLIENT 2

Client Mobile: CLIENT MOBILE NUMBER

Client Email: CLIENT EMAIL ADDRESS

Existing Details:

Type Of Application: TYPE OF APPLICATION

Property address : PROPERTY ADDRESS

Product Type: PRODUCT TYPE

Property Value: PROPERTY PRICE

Amount: Amount

B Name: B Name

Rate: RATE

date: DATE





Email i want is as below
--------------------------
Hi

Please find below details of the upcoming event

First Client Name : CLIENT 1
Joint Client: CLIENT 2
Client Mobile: CLIENT MOBILE NUMBER
Client Email: CLIENT EMAIL ADDRESS

Existing Details:

Type Of Application: TYPE OF APPLICATION
Property address : PROPERTY ADDRESS
Product Type: PRODUCT TYPE
Property Value: PROPERTY PRICE
Amount: Amount
B Name: B Name
Rate: RATE
date: DATE


ONE MORE QUESTION.
Instead of choosing data every time, how can i run the code directly using data from excel?

Thanks in advance.

Cheers!!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Hi,

Set the range as the date column you want to check down.
If the date is as expected then for each cell in the range you just grab the cell.offset info for each of the bits of info you want in the mail.
So all of the code like xRgText3.Offset(i - 1).Value would be cell.offset(0,x).value

Here's a simple example where the EmailSendTo = cell.Offset(0, 1).Value.
www.mrexcel.com

Send Email via Outlook based on Excel due Date

Hi Guys, I need expert to guide and show me how to send email automatically (via outlook) if the due date is near and already expire. The data available in row by row. I've 2 emails address in my column D and E respectively. If near due date (2 days before due), will send email to address # 1...
www.mrexcel.com www.mrexcel.com

As you are creating the mail in HTML you can use & "<br>" instead of & vbCrLf for line breaks.
If you want a gap add an extra <br> on the line preceding and the line in question


Code: 
xMailBody = "<HTML><BODY>" _
& "Hi <br><br>" _
& "Please find below details of the upcoming mortgage <br><br>" _
& "First Client Name : " & xRgText2.Offset(i - 1).Value & "<br>" _
& "Joint Client: " & xRgText3.Offset(i - 1).Value & "<br>" _
& "Client Mobile: " & xRgText4.Offset(i - 1).Value & "<br>" _
& "Client Email: " & xRgText5.Offset(i - 1).Value &  "<br><br>" _
& "Existing Details: <br><br>" _
& "Property address : " & xRgText.Offset(i - 1).Value & "<br>" _
& "Type Of Application: " & xRgText6.Offset(i - 1).Value & "<br>" _
& "Product Type: " & xRgText7.Offset(i - 1).Value & "<br>" _
& "Property Value: " & xRgText8.Offset(i - 1).Value & "<br>" _
& "Amount: " & xRgText9.Offset(i - 1).Value & "<br>" _
& "B Name: " & xRgText10.Offset(i - 1).Value & "<br>" _
& "Rate: " & xRgText11.Offset(i - 1).Value & "<br>" _
& "date: " & xRgDate.Offset(i - 1).Value & "<br>" _
& "</BODY></HTML>"
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
This code is to put a excel range onto a email
Replies
3
Views
407
I_know_nuffin
I
M
  • Question
Add text from specific cell into body of email
Replies
3
Views
928
Candyman8019
C
J
  • Solved
VBA - Send email based on a cells value; Include other cells value's from the same line in email subject
Replies
4
Views
955
Jibsta
J
J
  • Question
VBA code to send an email if a certain IF Criteria is met that loops when the spreadsheet is open
Replies
1
Views
222
joeyc123
J
R
  • Question
Automated emails based on Expiry date of different products into one mail
Replies
0
Views
916
Rajesh N
R

Forum statistics

Threads
1,214,615
Messages
6,120,538
Members
448,970
Latest member
kennimack

Share this page

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