Macro to email picking up email address in one cell using lookup [Solved/Closed]

Tom9o 11 Posts Monday February 18, 2013Registration date September 15, 2013 Last seen - Feb 18, 2013 at 01:53 AM - Latest reply: Tom9o 11 Posts Monday February 18, 2013Registration date September 15, 2013 Last seen
- Feb 19, 2013 at 11:32 AM
Hi can anyone help me I am using the VBA below to email a results sheet to various people,the code that I have will only allow me to email to one person at a time and I would have to change the email address in the code everytime, where you see "My Email address" is where I have to put the address that I am using. What I want to do is to put a code in is section so that it picks up an email address on my results sheet in cell "V1" as I have a lookup in that cell showing the emai address.


Sub Mail_Range()
'Working in 2000-2010
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("B1:O50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "My email address"
.CC = ""
.BCC = ""
.Subject = "This is Your Results"
.Body = "Hi there"
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub '

Hope someone can help me I have been trying everthing it is now driving me mad!!!!!!!!!!!!!!

Thanks for your help
See more 

6 replies

rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Feb 18, 2013 at 06:26 AM
0
Thank you
Are you sending same email to multiple people and what some thing like this

.To = "My email address, Email2, email 3"

or are you looking to send separate emails to each person
Tom9o 11 Posts Monday February 18, 2013Registration date September 15, 2013 Last seen - Feb 18, 2013 at 07:40 AM
0
Thank you
Hi rizvisa1 thanks for your reply some more info what I am trying to do is on the sheet that I am send by the macro there will an email address is cell V1 which will be there via a lookup so I need the email address in the macro to look at cell V1 so that it can pick up the email address and send it. Hope that makes sense, Thanks Tom
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Feb 18, 2013 at 07:52 AM
0
Thank you
hmm I am missing some thing here

From what I am now getting is that instead of hard coding value, you want to send email based on the value on V1. But I am sure there is more to it as you would have changed
line

.To = "My email address"

with
.To = Sheets("ResultSheet).range("V1")

so what I am missing
Tom9o 11 Posts Monday February 18, 2013Registration date September 15, 2013 Last seen - Feb 18, 2013 at 08:53 AM
0
Thank you
Hi rizvisa1 sorry we must be missing something this is not working
rizvisa1 4481 Posts Thursday January 28, 2010Registration dateContributorStatus January 6, 2016 Last seen - Feb 18, 2013 at 03:20 PM
Hello Tom
Sorry some typo on my part
What I was trying to say was
You have code

.To = "My email address"

I am presuming that you have some sheet called "ResultSheet". On that sheet in cell V1, you have a value that can be used for sending email

So I was proposing that may be this will work

.To = Sheets("ResultSheet").range("V1")
Tom9o 11 Posts Monday February 18, 2013Registration date September 15, 2013 Last seen - Feb 19, 2013 at 11:32 AM
Thanks rizvisa played about with you answer tried this and it work's great =ThisWorkbook.Sheets("ResultSheet").Range("V1").Value, so thanks for you help.