Envoi d'un email exell automatique

Sub EnvoiMail()
Dim lig As Long, drlig As Long, Msg As String
Dim Exped As String, Destinat As String, CopieA As String, ServSMTP As String

'**************** A ADAPTER ****************
Exped = "mail.expediteur@free.fr"
Destinat = "mail.destinataire@free.fr"
CopieA = "mail.CC@free.fr"
ServSMTP = "smtp.free.fr"
'*******************************************

drlig = Range("F" & Rows.Count).End(xlUp).Row
For lig = 6 To drlig
    If Cells(lig, 6).Value = "À PAYER" Then
        Msg = Msg & "La facture pour " & Cells(lig, 1) & ", d'un montant de " & Cells(lig, 2) & " €, est à payer pour le " & Cells(lig, 5) & "." & Chr(10) & Chr(10)
    End If
Next lig
Envoi Exped, Destinat, Msg, ServSMTP, CopieA
End Sub

'Sources :
'http://www.commentcamarche.net/forum/affich-21042611-envoi-mail-en-vba-avec-corps-message#15
'référence à cocher : Microsoft CDO for Windows 2000 Library
Sub Envoi(strPour As String, strDe As String, Msg As String, Serveur As String, Optional strCC As String)
Dim objMessage As Object

On Error GoTo errorHandler
Set objMessage = CreateObject("CDO.Message")
With objMessage
    .Subject = "Factures à échéance."
    .From = strDe
    .To = strPour
    .CC = strCC
    .TextBody = Msg
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    .Configuration.Fields.Update
    .Send
End With
MsgBox "Message transmis."
Exit Sub
errorHandler:
MsgBox Err.Description
End Sub