Envoi d'une sélection par Mail à Plusieurs Destinataires

[Foufoudora]

Bonjour le forum,
je viens vers vous pour solliciter vos lumières sur la macro de "Ron de Bruin" ci-jointe que normalement elle devrait envoyer par mail en utilisant outlook, une zone d'un fichier excel, à differents destinataires qui se trouvent sur la deuxieme feuille "Liste" colonne "L" mais malhereusement quand j'exécute la macro j'ai le message de sécurité Outlook mas rien qui se passe après. j'ai Outlook 2003 et j'ai déjà cocher dans références VBA Outlook 11.0 Object Library.

merci par avance

Cordialement

Foufoudora


Sub Mail_Range()
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim rng As Range
Dim Arr() As String
Dim N As Integer
Dim cell As Range
Set rng = Sheets("Liste").Columns("L").Cells.SpecialCells(xlCellTypeConstants)
ReDim Preserve Arr(1 To rng.Cells.Count)
N = 0
For Each cell In rng
If cell.EntireRow.Hidden = False And cell.Value Like "*@*" Then
N = N + 1
Arr(N) = cell.Value
End If
Next cell
ReDim Preserve Arr(1 To N)


Set Source = Nothing
On Error Resume Next
Set Source = Sheets("Projet").Range("A1:Q49").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
.SendMail Arr, "This is the Subject line"

On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub