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

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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,894
Office Version
  1. 2013
Platform
  1. Windows
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.

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>"
 

CLO001001

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

Spot on!!! It worked....

Cheers.
 

Forum statistics

Threads
1,141,715
Messages
5,708,049
Members
421,540
Latest member
quocbinh

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
Top