excel code tweak for outlook - confusing

  • Thread starter Thread starter periro16
  • Start date Start date
P

periro16

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?? :confused: :confused:

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 > " & 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
 
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 said:
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?? :confused: :confused:

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 > " & 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
Click to expand...
 
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"
...
 
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
 
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
 
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...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with VBA 4
Send data from Excel in email from specific email address 5
macro that uses data on diff. worksheet 1
Macro Help 3
sending email with Outlook using Excel 8
to many e-mails 2
Send a range in Excel as the body of an Outlook Express message 2
unexpected problem in VBA Code 2

Back
Top