Guys/gals
I am using the following code to send bulk emails from excel usin
outlook. I am a newbie so need your help.
Basically I want the code to be able to start from the C3 and then ge
emails from C3 to C40. Then names from D3 to D40. Then Targets et
from E3-E40...and so on.
Right now I cannot see how I can change the code to make it work like
want.
ANy ideas??
Thanks in advance :)
Code
-------------------
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 = "Recruitment Activity Statement "
' Compose the message
Msg = ""
Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Total Executive Interviews to date: " & vbCrLf & vbCrLf
Msg = Msg & Cells(r, 3).Text & ""
Msg = Msg & "Total Executive Interviews to date: <Exec Total [Q]" & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: <Remaining [u] " & Cells(r, 1) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct <Remain Rate [V] interviews each month." & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Your current Executive Interviewer rank: <Rank [T] " & Cells(r, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Msg from Recruitment team here" & Cells(r, 1) & "" & vbCrLf & vbCrLf & 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:00:02"))
Application.SendKeys "%s"
Next r
End Su
-------------------
--
periro1
-----------------------------------------------------------------------
periro16's Profile:
http://www.excelforum.com/member.php...fo&userid=2634
View this thread:
http://www.excelforum.com/showthread.php?threadid=39638