Logiciel mail compatibe avec Excel

Option Explicit

[COLOR="SeaGreen"]'Make a list in Sheet("Sheet1") with
'In column A the names of the people
'In column B the E-mail addresses

'
'The Macro will loop through each row in Sheet1 and if there is a E-mail address in column B
'and "yes" in column C it will create a mail with a reminder like this for each person.
'
'Exemple de message:
'Dear Jelle (Jelle is a name in column A for example)
'
'Please contact us to discuss bringing your account up to date
[/COLOR]

Sub CDO_Personalized_Mail_Body()
    Dim iMsg As Object
    Dim iConf As Object
    Dim cell As Range
    Dim Flds As Variant

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

    Set iConf = CreateObject("CDO.Configuration")

        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = [COLOR="Red"]"TonServeurSMTP"[/COLOR]
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With

    For Each cell In Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Offset(0, 1).Value <> "" Then
            If cell.Value Like "?*@?*.?*" Then
                Set iMsg = CreateObject("CDO.Message")
                With iMsg
                    Set .Configuration = iConf
                    .To = cell.Value
                    .From = [COLOR="Red"]"""Stanislas"" <stanislas@machin.fr>"[/COLOR]
                    .Subject = [COLOR="Red"]"TonSujet"[/COLOR]
                    .TextBody = [COLOR="Red"]"Dear "[/COLOR] & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
                                [COLOR="Red"]"TonMessage"[/COLOR]
                    .Send
                End With
                Set iMsg = Nothing
            End If
        End If
    Next cell

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

End Sub