snowbounduk
02-01-2011, 09:33 AM
I use the code below to email different sheets to different people. The code is replicated for each sheet and in the code I change the sheet, filename, to and subject.
I have a list on "Summary" which contains sheet name (this is also the filename) and email address. Any suggestions on how I can use this list as a range for the sheet, filename and to fields?
Many thanks
Sub Email_Backbone_Transmission_Interim()
'Variable declaration
Dim oApp As Object, _
oMail As Object, _
wb As Workbook, _
FileName As String
'Turn off screen updating
Application.ScreenUpdating = False
'Make a copy of the active sheet and save it to
'a temporary file
Sheets("Backbone Transmission").Select
ActiveSheet.Copy
Set wb = ActiveWorkbook
FileName = "Backbone Transmission.xls"
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="H:\" & FileName
'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "xxx@xxx.com"
'Uncomment the line below to hard code a subject
.Subject = "The latest programme report for your programme"
.Attachments.Add wb.FullName
.Display
End With
'Delete the temporary file
wb.ChangeFileAccess Mode:=xlReadOnly
Kill wb.FullName
wb.Close SaveChanges:=False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
I have a list on "Summary" which contains sheet name (this is also the filename) and email address. Any suggestions on how I can use this list as a range for the sheet, filename and to fields?
Many thanks
Sub Email_Backbone_Transmission_Interim()
'Variable declaration
Dim oApp As Object, _
oMail As Object, _
wb As Workbook, _
FileName As String
'Turn off screen updating
Application.ScreenUpdating = False
'Make a copy of the active sheet and save it to
'a temporary file
Sheets("Backbone Transmission").Select
ActiveSheet.Copy
Set wb = ActiveWorkbook
FileName = "Backbone Transmission.xls"
On Error Resume Next
Kill "C:\" & FileName
On Error GoTo 0
wb.SaveAs FileName:="H:\" & FileName
'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "xxx@xxx.com"
'Uncomment the line below to hard code a subject
.Subject = "The latest programme report for your programme"
.Attachments.Add wb.FullName
.Display
End With
'Delete the temporary file
wb.ChangeFileAccess Mode:=xlReadOnly
Kill wb.FullName
wb.Close SaveChanges:=False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub