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