Email from excel

[sujittalukde]

I have found a code to email from excel But the problem is that in opens message windows for the rows specified in the code which is "2 to 5" But if I specify 2 to 40, it opens 40 message windows. i want that itshall open only the requisite no. of windows if email address found in the rows and shall skip the blanks.

[vba]
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
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 5 'data in rows 2-5
' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Credit of salary"

' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "It is hereby informned that salary for the month has been " & _
"credited to your Bank a/c no. "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "Mr. A" & vbCrLf
Msg = Msg & "Senior HR"

' 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"
Next r
End Sub

[/vba]
thats to say for eg I set rows 2 to 40 in code but if the emails ids are entered for 30 recipients, then it shall open 30 msg windows only and not 40 as it is doing now.

Edited 15-Jun-07 by geekgirlau. Reason: insert line breaks

[Bob Phillips]

Just test Email for blank and step around the mailing code if so.

[sujittalukde]

Did not understand?

[Bob Phillips]

[vba]

If Email <> "" Then
'do the emailking stuff
End If
[/vba]

[sujittalukde]

I have tried in this manner but no mail is going out
[vba]
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim r As Integer, x As Double

If Email <> "" Then
For r = 2 To 5 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)

' Message subject
Subj = "Credit of salary"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "It is hereby informned that salary for the month has been " & _
"credited to your Bank a/c no. "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "Mr. A" & vbCrLf
Msg = Msg & "Senior HR"

' 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"

Next r
End If
End Sub
[/vba]

Edited 15=Jun-07 by geekgirlau. Reason: insert line breaks

[Bob Phillips]

You test the Email variable after setting it, not before.

[sujittalukde]

I have made it Just checkit out
[vba]
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
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 5 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)

If Email <> "" Then
' Message subject
Subj = "testing Credit of salary"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "It is hereby informned that salary for the month has been " & _
"credited to your Bank a/c no. "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "Mr. A" & vbCrLf
Msg = Msg & "Senior HR"

' 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 r
End Sub
[/vba]
Is this the correct approach?

Edited 15=Jun-07 by geekgirlau. Reason: insert line breaks

[Bob Phillips]

I cannot say that it is correct as I haven't tested, but it looks the right sort of approach to me.

[sujittalukde]

The code is working as desired. Can this following two things be added in the code?
1. In the code there is one msg wherein it is wrritten as Msg = Msg & "It is hereby informned that salary for the month has been credited to your Bank a/c no. "
I want that name of the month & year shall also be added to code. As this varies for month to month, this shall take from a cell of a sheet say cell A10 of Sheet2. How this can be done?
The final msg will be thus - "It is hereby informned that salary for the month of April2007 has been credited to your Bank a/c no." (April 2007 will come from Cell A10 of Sheet2.)

2. When the code will be run, a pop up message should appear asking user "Do you really want to send mails?" if the user clicks "yes" then mails should go out and if the user clicks "No", nothing should happen.

[Bob Phillips]

The code is working as desired. Can this following two things be added in the code?
1. In the code there is one msg wherein it is wrritten as Msg = Msg & "It is hereby informned that salary for the month has been credited to your Bank a/c no. "
I want that name of the month & year shall also be added to code. As this varies for month to month, this shall take from a cell of a sheet say cell A10 of Sheet2. How this can be done?
The final msg will be thus - "It is hereby informned that salary for the month of April2007 has been credited to your Bank a/c no." (April 2007 will come from Cell A10 of Sheet2.)

This line

[vba]

Msg = Msg & "It is hereby informned that salary for the month has been credited to your Bank a/c no. "
[/vba]

should be changed to


[vba]

Msg = Msg & "It is hereby informed that salary of " & Range("A10").Text & vbnewline & _
"for the month has been credited to your Bank a/c no. "
[/vba]

2. When the code will be run, a pop up message should appear asking user "Do you really want to send mails?" if the user clicks "yes" then mails should go out and if the user clicks "No", nothing should happen.

Just add a tested MsgBox before the Shell command and test for a yes or no.

[sujittalukde]

I have made it!
yes, i have made it!!!!
Though the code is not originally made by me but the modifiaction that I required, have been made by me and that too wihtput any theoretical macro knowledge. this has become possible because of the guidance by xld. it seems "THanks" would be a very small word but I think is the most appropriate. this would not been possible without your proper guidance
Though I not know you personally, but I think you are a good tutor also. the way you guiuded online, i think I would learn more from this forum.
Once agian , "THANKS".

Final code is given under:

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    Dim iResponse As Integer
    iResponse = MsgBox("Do you really want to send mails ?", vbYesNo + vbExclamation, "Email")
    Select Case iResponse
    Case vbYes
    For r = 2 To 5 'data in rows 2-4
'       Get the email address
 
        Email = Cells(r, 2)
  If Email <> "" Then
'       Message subject
        Subj = "testing Credit of salary"
'       Compose the message
        Msg = ""
        Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
        Msg = Msg & "It is hereby informed that salary for the month of " & Range("A10").Text & vbNewLine & _
"has been credited to your Bank a/c no. "
        Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "Mr. A" & vbCrLf
        Msg = Msg & "Senior HR"
 
'       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 r
  Case vbNo
         '            MsgBox Prompt:="You clicked No."
        Exit Sub
    End Select
End Sub