Sub Mail_Sheets()
'Working in 97-2010
Dim wb As Workbook
Dim Shname As Variant
Dim Addr As Variant
Dim N As Integer
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim I As Long
Shname = Array("P-Jean-Jacques", "JoeBloe")
adr1 = Sheets("P-Jean-Jacques").Cells(12, 1)
adr2 = Sheets("JoeBloe").Cells(12, 1)
Addr = Array(adr1, adr2)
If Val(Application.Version) >= 12 Then
'You run Excel 2007-2010
FileExtStr = ".xlsm": FileFormatNum = 52
Else
'You run Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("temp") & "\"
'Create the new workbooks/Mail it/Delete it
For N = LBound(Shname) To UBound(Shname)
TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss")
ThisWorkbook.Sheets(Shname(N)).Copy
Set wb = ActiveWorkbook
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum
On Error Resume Next
For I = 1 To 3
.SendMail Addr(N), _
"This is the Subject line"
If Err.Number = 0 Then Exit For
Next I
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub