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

ATM the code loops through rows 2 to 4 which is what the line:
For r = 2 To 4 'data in rows 2-4
is doing. To increase this just replace the numbers so For r=3 To 40 will
reads rows 3 thru' 40

The code Cells(r,x) is reading values from the cells with a row of r and a
column of x, so the line:
Email = Cells(r, 2)
reads the cell at row r and column 2 (i.e. cell B2 if r=2).

I think you need to go through the code changing the parameters each time
the Cells method is used so it is reading the correct column.
--
HTH

Simon


"periro16" wrote:


Guys/gals

I am using the following code to send bulk emails from excel using
outlook. I am a newbie so need your help.

Basically I want the code to be able to start from the C3 and then get
emails from C3 to C40. Then names from D3 to D40. Then Targets etc
from E3-E40...and so on.

Right now I cannot see how I can change the code to make it work like I
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 Sub
--------------------


--
periro16
------------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396386

That has made it more clear - thanks

How do I get rid of the Subscript out of range error??
I am using he following and it gives me the range error above. I
there a way around it?

Code
-------------------
.....

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) & vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct"
...
-------------------
:confused

--
periro1
-----------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...fo&userid=2634
View this thread: http://www.excelforum.com/showthread.php?threadid=39638

hello I have the code below which orginally was being used only to work
off the current sheet. Now I have decided to put the macro button a
different worksheet. How do I set the the code so it uses the data on
"Datasheet"?
ie. for emails and msgs??
Many thanks!!


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
Dim cell As Range

For r = 7 To 8 'data in rows 2-4

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

' Message subject
Subj = "Recruitment Activity Statement "

' Compose the message

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) & vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct "
Msg = Msg & Cells(r, 22) & " interviews each month." & vbCrLf & vbCrLf
Msg = Msg & "Your current Executive Interviewer rank: "
Msg = Msg & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "Msg from recruitment team - " & Cells(r, 1) & vbCrLf & vbCrLf & vbCrLf
Msg = Msg & "Thanks for your continued involvement! " & vbCrLf & vbCrLf
Msg = Msg & "The UKDC Recruitment Team"

' 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







--------------------


--
periro16
------------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396386

I'd guess that the line:
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value &
vbCrLf & vbCrLf
is the one causing the error? If so, it means you no longer have a sheet
called Sheet1. You'll need to change the sheet (and maybe the range?) from
which you want to get the value
--

Simon


"periro16" wrote:


That has made it more clear - thanks

How do I get rid of the Subscript out of range error??
I am using he following and it gives me the range error above. Is
there a way around it?

Code:
--------------------
.....

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) & vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct"
....
--------------------



--
periro16
------------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396386

Every time to read data using the Cells method you'll need to change it to:
ThisWorkbook.Worksheets("datasheet").Cells...

or if the data is going to be in a different workbook:
Workbooks("name_of_book").Worksheets("datasheet"). Cells...
--

Simon


"periro16" wrote:


hello I have the code below which orginally was being used only to work
off the current sheet. Now I have decided to put the macro button a
different worksheet. How do I set the the code so it uses the data on
"Datasheet"?
ie. for emails and msgs??
Many thanks!!


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
Dim cell As Range

For r = 7 To 8 'data in rows 2-4

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

' Message subject
Subj = "Recruitment Activity Statement "

' Compose the message

Msg = vbCrLf
Msg = Msg & "Dear " & Cells(r, 3) & vbCrLf & vbCrLf

Msg = Msg & "Total Executive Interviews to date: " & Cells(r, 17) & vbCrLf & vbCrLf
Msg = Msg & "Your target for FY06: " & Sheets("Sheet1").Range("B1").Value & vbCrLf & vbCrLf
Msg = Msg & "Remaining to hit target: " & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "In order to achieve this you need to conduct "
Msg = Msg & Cells(r, 22) & " interviews each month." & vbCrLf & vbCrLf
Msg = Msg & "Your current Executive Interviewer rank: "
Msg = Msg & Cells(r, 21) & vbCrLf & vbCrLf
Msg = Msg & "Msg from recruitment team - " & Cells(r, 1) & vbCrLf & vbCrLf & vbCrLf
Msg = Msg & "Thanks for your continued involvement! " & vbCrLf & vbCrLf
Msg = Msg & "The UKDC Recruitment Team"

' 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







--------------------


--
periro16
------------------------------------------------------------------------
periro16's Profile: http://www.excelforum.com/member.php...o&userid=26345
View this thread: http://www.excelforum.com/showthread...hreadid=396386