Macro Help Required

[Dan Wood]

I have a few questions:-

1) I am running the following macro to look through my spreadsheet, and
every value 0 in the range it produces an email. However the problem i have
is if there is more then one value 0 the email produces multiple times. For
example if there are 2 cells with value 0, the email produces twice for each
cell, if there are 3 cells then the email produces 9 times. All i want is the
email to produces once for each system. The code is as below

Sub CheckDay()
Application.OnTime TimeValue("14:35:00"), "CheckDay"
For Each c In Range("D7:D30")
If c.value = 0 Then
Call SendEmail
End If
Next
End Sub

2) My next question is how do i get my macro to run at a set time? The
second line of the code worked at first but not now. Any clues as to why it
has broken?

3) Last question, is there a way to run a macro without the sheet being open?

Thanks in advance

[Gord Dibben]

Dan

For correct usage of the OnTime method see Chip Pearson's site.

You need to give OnTime more specific instructions on when and what to run.

As far as the double and triple emails goes, your SendMail routine would
seem to be the generator.

No you cannot run a routine with the workbook closed.

You may be better off to use Windows Task Schedular to open Excel with a
Command line to open the workbook at 14:35 each day, with workbook_open to
run the code to send the emails, then close Excel.

First you must clean up your SendMail routine to prevent the multiples.

Gord Dibben MS Excel MVP

[Dan Wood]

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.

[Gord Dibben]

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