VBA Help please

[leemcder]

Hi I want to use this macro to email every sheet in a workboot but can anyone tell me what lines I need to add/amend so if a person is receiving more than 1 sheet, they will only get 1 email with each attachment and not say 10 emails. I will be emailing hundreds of sheets to several people but I just want each person to receive 1 email each containing all their attachments. I also want to have a sheet called Mailinfo containing all my colleagues names and email addresses, so their names will be in cell A1 of each sheet and the email will be sent to that person. Can anyone help with this?

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: ​

http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
TempFilePath = Environ$("temp") & ""
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
For Each sh In ThisWorkbook.Worksheets
If sh.Range("A2").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = sh.Range("A2").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add wb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub​

 

[ranman256]

why would you email 1 sheet at a time?
cant you just email the 1 workbook to a user? thats 1 attachement.

 

[leemcder]

why would you email 1 sheet at a time?
cant you just email the 1 workbook to a user? thats 1 attachement.

Hi, because I have over 200 sheets, and each sheet is going to different people. Each sheet has the persons names in call A2, and I need to email each sheet to the person in cell A2. Some people may receive more than one sheet. The current script emails each sheet separately, I want it to email each person once, with all the attachments relating to them. I also want it do lookup the person in cell A2 to a sheet I have named mailinfo and pull the persons email address from that list.

 

[ranman256]

ok, how about 1 email to a person, bob gets his 5 sheets,
sally gets 10 sheets (10 attachments)

or
do you want bob to get 1 workbk w 5 sheets
sally with 1 workbk, w 10 sheets?

(the 1st one is easier)

 

[leemcder]

Hi, thanks for the reply. Just one email with seperate sheets is exactly what i want. So bob would get 1 email with his 5 attachments.