sridhar_shri03
New Member
Hiiiii
i have an issue if solved much appreciated
I am an BPO Employee i have to send monthly ratings to my team members, by personalised mails to each and every one in my team with the data available in excel
for Ex:
In column A i have name of the team members and in Column B i have their e mail addresses, and their performance ratings in C,D,E,F like that, and i need to send mails to each and every one from my excel with their name followed by a common msg in all mails and followed by a table consist of data available in each row for that receipent with the data avaialable in column C,D,E,F with the header for the table as first row, when i run the macro i need to send the mails to all receipents available in the excel.
I have tried some codes which helped me to some extent but i cant able to get the table with the data available in column C,D,E,F for each receipent
Below is the Vba code worked some extent
`
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 4 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)
' Message subject
Subj = "Your Annual Bonus"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that your annual bonus is "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
' 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
'
Please help me and save my life
Thanks
i have an issue if solved much appreciated
I am an BPO Employee i have to send monthly ratings to my team members, by personalised mails to each and every one in my team with the data available in excel
for Ex:
In column A i have name of the team members and in Column B i have their e mail addresses, and their performance ratings in C,D,E,F like that, and i need to send mails to each and every one from my excel with their name followed by a common msg in all mails and followed by a table consist of data available in each row for that receipent with the data avaialable in column C,D,E,F with the header for the table as first row, when i run the macro i need to send the mails to all receipents available in the excel.
I have tried some codes which helped me to some extent but i cant able to get the table with the data available in column C,D,E,F for each receipent
Below is the Vba code worked some extent
`
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 4 'data in rows 2-4
' Get the email address
Email = Cells(r, 2)
' Message subject
Subj = "Your Annual Bonus"
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "I am pleased to inform you that your annual bonus is "
Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
Msg = Msg & "William Rose" & vbCrLf
Msg = Msg & "President"
' 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
'
Please help me and save my life
Thanks