Solved Using a Macro to email a Results Sheet

February 16, 2013 at 13:26:16
Specs: Windows 7
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 pick up an email address on my results sheet.
With OutMail
.To = "My email address" what can I use in thsi section so that it looks at one cell in the result sheet
.CC = ""
.BCC = ""
.Subject = "This is Your Results"
.Body = "Hi there"
.Attachments.Add Dest.FullName
.Send

This is the full code that I am using.
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 '

Thanks for any help



See More: Using a Macro to email a Results Sheet

Report •

#1
February 17, 2013 at 14:09:54
✔ Best Answer
Hi

Assuming you have a list of addresses in Sheet2 starting in Cell A1 you can insert this code ...

'Getting list of recipient email addresses

lAddr = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
toList = ""

    For i = 1 To lAddr
        If i <> lAddr Then
            toList = toList & Sheets(2).Cells(i, 1) & ";"
        Else
            toList = toList & Sheets(2).Cells(i, 1)
        End If
    Next

Place this code where the originating workbook is still active e.g. after this sequence;

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

Then substitute "toList" (without the quotes) where you have "My Email Address). It should look like this;

 With OutMail
 .To = toList
 .CC = ""
 .BCC = ""
 .Subject = "This is Your Results"
 .Body = "Hi there"
 .Attachments.Add Dest.FullName
 .Send
 End With

Give this a try (with dummy addresses) and see if you get the results you are expecting.


Report •

#2
February 18, 2013 at 04:04:40
tomR:

Before posting any more code in this forum, please click on the following line and read the instructions found via that link. Thanks!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#3
February 19, 2013 at 18:43:27
Hi AlteK,

Thanks it works well I did not have a list but I altered things to suit and it is now working ok ,

Thanks again


Report •
Related Solutions


Ask Question