email different sheets to different people - code needs changing

[snowbounduk]

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

[JP2112]

Instead of copying the same code to each sheet and then hardcoding the email subject and filename, why not write a generic function that takes the values as parameters? Then you could have just one reusable copy which could be called from each sheet, instead of multiple copies of (essentially) the same function.

All you would need to do then is set an object reference to the range with the sheet names and email addresses, assign the values to an array, then loop through the array and call the generic function to send out the message.

You could go even further with this -- since the filename is the same as the sheet name, you can just loop through each worksheet and use the sheet name to determine the filename.

[snowbounduk]

You could go even further with this -- since the filename is the same as the sheet name, you can just loop through each worksheet and use the sheet name to determine the filename.

That is what I would like to do but do not know where to start!

[JP2112]

I whipped up a quick function that takes a sheet name, recipient name and email subject and sends the given worksheet as a separate workbook to the recipient. It should work as is, but you probably want to step through it and make sure it works as intended.

All you need now is a procedure that loops through each sheet and passes the sheet name to the function. You also need to set a reference to that range with the email addresses and include it in the loop.

Sub EmailSheet(sheetName As String, recipient As String, subject As String)
Dim newWorkbook As Excel.Workbook
' save given sheet to new workbook
' add new workbook
Set newWorkbook = Excel.Workbooks.Add
' copy worksheet to new workbook
Worksheets(sheetName).Copy newWorkbook.Sheets(newWorkbook.Sheets.count)
' save workbook to temp folder with worksheet name as filename
newWorkbook.SaveAs environ("temp") & "\" & sheetName & ".xls"
'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
.Recipients.Add recipient
'Uncomment the line below to hard code a subject
.subject = subject
.Attachments.Add environ("temp") & "\" & sheetName & ".xls"
.display ' or .Send
End With

' delete the temp workbook
Kill environ("temp") & "\" & sheetName & ".xls"
End Sub

[snowbounduk]

Thanks for that, I will try it out later today.

Thanks again