Macro Help
 

My code is as follows:-

Sub SendEmail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Range("A5")
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 O&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus


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


End If
Next

However, when i try to run the script it flags up an error in the
ShellExecute part and i cannot figure out why.

Any help much appreciated

Macro Help
 

Check out this code as a way to send emails without security warnings.

http://www.rondebruin.nl/cdo.htm
--
HTH...

Jim Thomlinson


"Dan Wood" wrote:

My code is as follows:-

Sub SendEmail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Range("A5")
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 O&, vbNullString, URL, vbNullString, vbNullString,
vbNormalFocus


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


End If
Next

However, when i try to run the script it flags up an error in the
ShellExecute part and i cannot figure out why.

Any help much appreciated

Macro Help
 

Thanks for the advice but i don't really want to take that route as this
spreadsheet is going to be used as a template for lots of different users to
have to monitor passwords expiring.

The aim is for it to pick up the email address from cell A5.

Any ideas on what i need to change?

Thanks

Macro Help
 

See
http://www.rondebruin.nl/mail/oebody.htm

I think you forgot to copy the function

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm



"Dan Wood" wrote in message ...
Thanks for the advice but i don't really want to take that route as this
spreadsheet is going to be used as a template for lots of different users to
have to monitor passwords expiring.

The aim is for it to pick up the email address from cell A5.

Any ideas on what i need to change?

Thanks