PDA

View Full Version : Solved: Need Excel VBA help :(



BVks1
03-05-2012, 04:20 PM
Hello! I have already created my database that will generate an email in outlook for my team when their cards are expired - I was able to get the VBA code to say everything I needed in the email with the correct format, but am having a little trouble with VBA recognizing an IF statment that will ONLY send out an email when the cards expire. Currently it sends out emails to the entire datase. I have been playing with code to try to get it to recognize when

If Cells(r, 9) = "EXPIRED" Then,

My SendEmail code

Else If

Exit Sub

End IF

End Sub

Not Working!!

Please Help....Hope I dont have to completely rewrite my entire code for this lttle bit!

Below is my code....

Sub SendEMail()

Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double
For r = 2 To 4 'data in rows 2-4

If Cells(r, 9) = "CURRENT" Then
Exit Sub
End If


' Get the email address
Email = Cells(r, 4)

' Message subject
Subj = "Renewal Card"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "This is a reminder that you are approaching the expiration date for the card: "
Msg = Msg & Cells(r, 5).Text & ", specifically relating to the "

Msg = Msg & Cells(r, 8).Text & ". Please contact your site safety department to schedule training and renewal before your expiration date of "

Msg = Msg & Cells(r, 7).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "********" & vbCrLf
Msg = Msg & "******!" & vbCrLf

' 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:0:02"))
Application.SendKeys "%s"
Next r
End Sub

mdmackillop
03-05-2012, 04:29 PM
Why not simply
For r = 2 To 4 'data in rows 2-4

If Cells(r, 9) = "EXPIRED" Then

' Get the email address
'all your code

End If

Next r

BVks1
03-05-2012, 04:43 PM
@mdmackillop

Tried that...I get a compile error that says "Next without For" for some reason...

Bob Phillips
03-05-2012, 04:48 PM
Then you have got it wrong. Probably a missing End If or something. Show your code where you tried it.

BVks1
03-05-2012, 05:02 PM
Then you have got it wrong. Probably a missing End If or something. Show your code where you tried it.

You were exactly right! I missed the End if...it is working perfectly now...thank you both so much! mdmackillop is a genius!