Anomandaris
04-02-2009, 08:04 AM
Hi guys
I have a macro thanx to an expert here(xld). It sends emails to multiple recipients, now I need to add a line that will enable it to CC. the email to recipients listed in the first Row (Sheet1 - Row 1).
Here's the code
Sub SendMailNEST()
Const MatchCode As String = "NEST"
Dim wb As Workbook
Dim LastRow As Long
Dim LastCol As Long
Dim OLApp As Object
Dim EmailItem As Object
Dim EmailRecip As Object
Dim j As Long
With Worksheets("Sheet1")
Worksheets("Sheet2").Copy
Set wb = ActiveWorkbook
wb.SaveAs "Part of" & ThisWorkbook.Name & "" & ".xls"
wb.ChangeFileAccess xlReadOnly
Set OLApp = CreateObject("Outlook.Application")
Set EmailItem = OLApp.CreateItem(0)
EmailItem.Subject = "Recap"
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
For j = 2 To LastCol
Set EmailRecip = EmailItem.Recipients.Add(.Cells(2, j).Value)
EmailRecip.Type = 1
Next j
EmailItem.Body = "Hi, " & .Cells(2, 1).Value & ", here is today's summary"
EmailItem.Attachments.Add wb.FullName
EmailItem.Display 'Send
Kill wb.FullName
Set wb = Nothing
Set EmailItem = Nothing
Set OLApp = Nothing
End With
End Sub
Any ideas?
Thanks
I have a macro thanx to an expert here(xld). It sends emails to multiple recipients, now I need to add a line that will enable it to CC. the email to recipients listed in the first Row (Sheet1 - Row 1).
Here's the code
Sub SendMailNEST()
Const MatchCode As String = "NEST"
Dim wb As Workbook
Dim LastRow As Long
Dim LastCol As Long
Dim OLApp As Object
Dim EmailItem As Object
Dim EmailRecip As Object
Dim j As Long
With Worksheets("Sheet1")
Worksheets("Sheet2").Copy
Set wb = ActiveWorkbook
wb.SaveAs "Part of" & ThisWorkbook.Name & "" & ".xls"
wb.ChangeFileAccess xlReadOnly
Set OLApp = CreateObject("Outlook.Application")
Set EmailItem = OLApp.CreateItem(0)
EmailItem.Subject = "Recap"
LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
For j = 2 To LastCol
Set EmailRecip = EmailItem.Recipients.Add(.Cells(2, j).Value)
EmailRecip.Type = 1
Next j
EmailItem.Body = "Hi, " & .Cells(2, 1).Value & ", here is today's summary"
EmailItem.Attachments.Add wb.FullName
EmailItem.Display 'Send
Kill wb.FullName
Set wb = Nothing
Set EmailItem = Nothing
Set OLApp = Nothing
End With
End Sub
Any ideas?
Thanks