PDA

View Full Version : Email from excel



sujittalukde
06-13-2007, 06:36 AM
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.


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


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
06-13-2007, 06:53 AM
Just test Email for blank and step around the mailing code if so.

sujittalukde
06-13-2007, 09:41 PM
Did not understand?

Bob Phillips
06-14-2007, 01:07 AM
If Email <> "" Then
'do the emailking stuff
End If

sujittalukde
06-14-2007, 01:25 AM
I have tried in this manner but no mail is going out

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


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

Bob Phillips
06-14-2007, 01:37 AM
You test the Email variable after setting it, not before.

sujittalukde
06-14-2007, 02:03 AM
I have made it Just checkit out

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

Is this the correct approach?

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

Bob Phillips
06-14-2007, 03:09 AM
I cannot say that it is correct as I haven't tested, but it looks the right sort of approach to me.

sujittalukde
06-14-2007, 03:20 AM
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
06-14-2007, 04:26 AM
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



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


should be changed to




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



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
06-14-2007, 10:24 PM
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