View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
Gord Dibben Gord Dibben is offline
external usenet poster
 
Posts: 22,906
Default Macro Help Required

Your SendMail For.....Next routine repeats what your CheckDay routine does.

Sub CheckDay()
Application.OnTime TimeValue("14:35:00"), "CheckDay"


For Each c In Range("D7:D30")
If c.value = 0 Then
Call SendEmail 'one zero......one call.......one email

one zero gets you one call to SendMail which sends one email

SendMail then loops through again

For Each c In Range("D7:D30")
If c.value = 0 Then

two zeros gets you two calls to SendMail which sends an email for each call
thus doubling up.

three zeros gets you three calls which triples up

End If
Next
End Sub


I would dispense with the CheckDay routine and just run SendMail by itself.

If you want a daily timed running use Task Scheduler.

You may also want to see Ron de Bruin's code for sending mail from Excel.

http://www.rondebruin.nl/sendmail.htm


Gord




On Tue, 5 Jan 2010 02:35:01 -0800, Dan Wood
wrote:

My send email script is as follows:-

Sub SendEmail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Range("H1")
For Each c In Range("D7:D30")
If c.value = 0 Then
SySname = c.Offset(, -3).value
Subj = SySname

Msg = ""
Msg = Msg & "Hi" & Cells(ActiveCell.Row, 6) & "," & vbCrLf & vbCrLf &
"Your AS400 password is due to expire on the above mentioned system. Please
log on and change your password" & vbCrLf & vbCrLf & "Once you have done this
please update the spreadsheet to reflect the new password, and the date it
was changed."

'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")

'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")

'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg

'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus

'Wait two seconds before sending keystrokes
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End If
Next
End Sub

Which part of this do you think needs amending as i cannot see what can be
removed.