Okey remove Comment that lines also,
Option Explicit
Sub CDO_Mail_Small_Text()
Dim wsMain As Excel.Worksheet
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim strToaddress As String
Dim index As Long
Dim Flds As Variant
Const UAFEQ1TOT = "UAFEQ1 Total"
Const ALPROPTOT = "ALPROP Total"
Const UAFEQ1TOTEMAIL = "john@example.com"
Const ALPROPTOTEMAIL = "peter@example.com"
'Set Source Worksheet name to the work sheet object
Set wsMain = ActiveSheet
'Set outline group level (I assume its maximum level is 3)
'wsMain.Outline.ShowLevels 3
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "Fill in your SMTP server here"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
For index = 2 To wsMain.UsedRange.Rows.Count
If wsMain.Cells(index, 1).Value = UAFEQ1TOT Or wsMain.Cells(index, 1).Value = ALPROPTOT Then
If wsMain.Cells(index, 1).Value = UAFEQ1TOT And wsMain.Cells(index, 5).Value > 0 Then
strToaddress = UAFEQ1TOTEMAIL
strbody = "Please see deposit of " & wsMain.Cells(index, 5).Value
ElseIf wsMain.Cells(index, 1).Value = UAFEQ1TOT And wsMain.Cells(index, 5).Value < 0 Then
strToaddress = UAFEQ1TOTEMAIL
strbody = "Please see withdrawal of " & wsMain.Cells(index, 5).Value
ElseIf wsMain.Cells(index, 1).Value = ALPROPTOT And wsMain.Cells(index, 5).Value > 0 Then
strToaddress = ALPROPTOTEMAIL
strbody = "Please see deposit of " & wsMain.Cells(index, 5).Value
ElseIf wsMain.Cells(index, 1).Value = ALPROPTOT And wsMain.Cells(index, 5).Value < 0 Then
strToaddress = ALPROPTOTEMAIL
strbody = "Please see withdrawal of " & wsMain.Cells(index, 5).Value
End If
With iMsg
Set .Configuration = iConf
.to = strToaddress
.CC = ""
.BCC = ""
.From = """Ron"" <ron@something.nl>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With
End If
Next
End Sub
Get the smtp sereve details from outlook:
Tools - Account Settings -
(Click change ur existing account - u can view the all details about that account)
Bookmarks