Hi, I am using this macro to email every sheet in a workbook 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 containing several attachments 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. Can anyone please help? Thanks
Code:
[LEFT][COLOR=#333333][FONT=Verdana]Sub Mail_Every_Worksheet()[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'Working in Excel 2000-2016[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'For Tips see: [/FONT][/COLOR][/LEFT][URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
[LEFT][COLOR=#333333][FONT=Verdana]Dim sh As Worksheet[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim wb As Workbook[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim FileExtStr As String[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim FileFormatNum As Long[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim TempFilePath As String[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim TempFileName As String[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim OutApp As Object[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim OutMail As Object[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]TempFilePath = Environ$("temp") & ""[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If Val(Application.Version) < 12 Then[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'You use Excel 97-2003[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]FileExtStr = ".xls": FileFormatNum = -4143[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Else[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'You use Excel 2007-2016[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]FileExtStr = ".xlsm": FileFormatNum = 52[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]With Application[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].EnableEvents = False[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set OutApp = CreateObject("Outlook.Application")[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]For Each sh In ThisWorkbook.Worksheets[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If sh.Range("A2").Value Like "?*@?*.?*" Then[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]sh.Copy[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set wb = ActiveWorkbook[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]TempFileName = "Sheet " & sh.Name & " of " _[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]& ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set OutMail = OutApp.CreateItem(0)[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]With wb[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]On Error Resume Next[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]With OutMail[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].to = sh.Range("A2").Value[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].CC = ""[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].BCC = ""[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].Subject = "This is the Subject line"[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].Body = "Hi there"[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].Attachments.Add wb.FullName[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'You can add other files also like this[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]'.Attachments.Add ("C:\test.txt")[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].Display 'or use .Display[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]On Error GoTo 0[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].Close savechanges:=False[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana][/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set OutMail = Nothing[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Kill TempFilePath & TempFileName & FileExtStr[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Next sh[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set OutApp = Nothing[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]With Application[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana].EnableEvents = True[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End With[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End Sub[/FONT][/COLOR][/LEFT]
