Dear All
I have posted something similar but unfortunately I couldn't get the suggestions working. I have attached my vba code which I had help with as I am new to vba. What I need to do is to add criteria to when a customer spends more than 1000 (for the first part of the code) to send an email (this bit works) and at the same time the cell which has the name on (in my spread sheet is cell range B and columns 2 onwards) to change colour and if possible to start blinking (or change colour from red to white for example) .
I have attached my code below and any help will be greatly appreciated if some one can add this to me code as I am really confused.
Thanks again
Dim i As Long
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
With Sheets("Sheet1")
' if 30 days have passed and customer has spent more than 1000 and want to recive email
For i = 5 To .Range("A" & Rows.Count).End(xlUp).Row
If DateDiff("d", .Cells(i, 10).Value, Now) >= 30 And .Cells(i, 11).Value = "y" And .Cells(i, 8).Value >= 1000 Then
If DateDiff("d", .Cells(i, 9).Value, Now) >= 30 Then
'send email using Gmail
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/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myemail@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This email was sent" & vbNewLine & _
"using vba code via" & vbNewLine & _
"Office 365 mail client" & vbNewLine & _
"for emailing clients spending more than 1000" & vbNewLine
With iMsg
Set .Configuration = iConf
.To = "myemail@gmail.com"
.CC = ""
.BCC = ""
.From = """name"" "
.Subject = "sending email via excel using Gmail client"
.TextBody = strbody
' With CreateObject("Outlook.Application").CreateItem(0)
' .To = Sheets("Sheet1").Cells(i, 2).Value
' .CC = "v.razaghzadeh@gmail.com;v.razaghzadeh@talktalk.net"
' .Subject = "30 Days has passed since your last purchase."
' .Body = "Dear " & Cells(i, 1).Value & Cells(i, 2).Value & vbNewLine & vbNewLine & _
"It has been a while since you have visited the Tea and Coffee Department ......"
.Send ' Change to .Send to skip the display
End With
.Cells(i, 10).Value = Format(Now, "dd/mm/yyyy")
End If
ElseIf DateDiff("d", .Cells(i, 10).Value, Now) >= 15 And .Cells(i, 11).Value = "y" And .Cells(i, 8).Value >= 500 And .Cells(i, 8).Value < 1000 Then
If DateDiff("d", .Cells(i, 9).Value, Now) >= 15 Then
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/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "myname.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypasswrod"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This email was sent" & vbNewLine & _
"using vba code via" & vbNewLine & _
"Gmail client" & vbNewLine & _
"for emailing clients spending more than 500" & vbNewLine
With iMsg
Set .Configuration = iConf
.To = "myname@gmail.com"
.CC = ""
.BCC = ""
.From = """name"" "
.Subject = "sending email via excel using Gmail client"
.TextBody = strbody
'send email using Office365
' With CreateObject("Outlook.Application").CreateItem(0)
' .To = Sheets("Sheet1").Cells(i, 2).Value
' .CC = "v.razaghzadeh@gmail.com;v.razaghzadeh@talktalk.net"
' .Subject = "15 Days has passed since your last purchase."
' .Body = "Hi " & Cells(i, 1).Value & Cells(i, 2).Value & vbNewLine & vbNewLine & _
' "Come and buy more things!"
.Send ' Change to .Send to skip the display
End With
.Cells(i, 10).Value = Format(Now, "dd/mm/yyyy")
End If
'.Cells(i, 9).Value = Format(Now, "dd/mm/yyyy")
End If
Next i
End With
End Sub
Bookmarks