Base de donnée d'email sur Excel

Bonjour,

J'ai une base de donnée qui comporte 100 emails.Je voudrais envoyer le même message pour tous les contacts sans que l'adresse de l'autre apparait sur le mail.Je voulais savoir est ce qu'il existe une fonction pour la faire (A noter que j'utilises Outlook et Gmail).

Merci d'avance.

bonjour

une idée

Option Explicit
Public Sub CDO_Mail_ActiveSheet()
Dim wbSource As Workbook, wbNew As Workbook
Dim FileExtStr As String, TempFilePath As String, TempFileName As String
Dim FileFormatNum As Long
Dim iMsg As Object, iConf As Object
Dim Flds As Variant
Dim signature As String

If MsgBox("Etes-vous certain de vouloir envoyer cette email ?", vbQuestion + vbYesNo, _
            "Demande de confirmation") <> vbYes Then Exit Sub

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

    Set wbSource = ActiveWorkbook
    ' Copie la feuille active dans un nouveau classeur.
   ActiveSheet.Copy
    ' Ou si vous voulez copier plusieurs feuilles. Utilisez :
   ' wbSource.Sheets(Array("Sheet1", "Sheet3")).Copy

   ActiveSheet.Shapes.Range(Array("bouton1")).Select 'Efface le bouton d'envoie
    Selection.Delete

   Set wbNew = ActiveWorkbook
    ' On détermine la version Excel et l'extension du fichier / Format
   With wbNew
        If Val(Application.Version) < 12 Then
            ' Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' 2007-2010
           ' On sort de la procédure dans le cas les macros sont désactivées.
           ' *** cas ou cette procédure est lancée d'un autre classeur (ex : Personal.xlsb).***
           If wbSource.Name = .Name Then
                Application.EnableEvents = True
                MsgBox "Vous n'avez pas activé les macros."
                Exit Sub
            Else
                Select Case wbSource.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
    ' Sauve le nouveau classeur, poste le message et supprime le fichier temporaire crée.
   TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & wbSource.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With wbNew
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        MsgBox TempFilePath & TempFileName & FileExtStr
        .Close savechanges:=False
    End With

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1    ' Source par défaut CDO
   Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "" ' ton email
       .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "" ' ton mot de pass
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.google.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    With iMsg
        Set .Configuration = iConf

        signature = "" & vbCrLf & "" 'changer votre nom entre les " "
        .To = "" ' l'adresse du receptionneur
       .CC = "" ' copie conforme
        .BCC = "" ' copie conforme caché
        .From = "" ' de qui
       .Subject = "" ' à modifier
       .TextBody = "Bonjour," & vbCrLf & "le texte a metre ou a envoyer ligne 1," & vbCrLf & "cordialement" & vbCrLf & signature 'à modifier
       .AddAttachment TempFilePath & TempFileName & FileExtStr
        .Send
    End With

    'Supprime le fichier envoyé.
   Kill TempFilePath & TempFileName & FileExtStr

    Application.EnableEvents = True

    Set Flds = Nothing
    Set iConf = Nothing
    Set iMsg = Nothing
    Set wbNew = Nothing: Set wbSource = Nothing

End Sub

cordialement

Merci beaucoup pour votre réponse.