VB Excel OUTLOOK liste adresses mails [Résolu]

---- procédure Excel VBA ----------------- 
Sub test1 

' Récupérer les mails des destinataires 
Workbooks("test.xls").Activate 
Sheets("admin").Activate 
MailAd = Range("J11").Value 

sujet = "test01-sujet" 
message = "test01-message" 

'choix pièce jointe 
NomFichier= Application.GetOpenFilename

' appelle une sous-procédure Outlook VBA 
Set appli_Outlook = New Outlook.Application 
call appli_Outlook .test2(MailAd,sujet,message,NomFichier) 

end Sub 

-- procédure Outlook VBA ------ 
Sub test2(mail_liste,sujet,Message,NomFichier)

If NomFichier Then
        Set pièce_jointe = e_mail.Attachments
        pièce_jointe.Add NomFichier, olByValue, 1, NomFichier
End If

 

' appelle une sous-procédure Outlook VBA
Set appli_Outlook = Outlook.Application
If appli_Outlook.Explorers.Count > 0 Then
    Call appli_Outlook.test2(MailAd, sujet, Message, NomFichier)
Else
    MsgBox "erreur envoi e_mail car outlook non chargé"
End If
 

Sous Excel VBA:

Sub test1()

Workbooks("julieC - Irsem.xls").Activate
' Récupérer les mails des destinataires
Sheets("admin").Activate
MailAd = Range("N50").Value 'la valeur est une adresse mail
sujet = "Test envoi"
Message = "coucou, recevez-vous ce message?"

'choix pièce jointe
'NomFichier = Application.GetOpenFilename

' appelle une sous-procédure Outlook VBA
Set appli_Outlook = outlook.Application
If appli_Outlook.Explorers.Count > 0 Then
    Call appli_Outlook.test2(MailAd, sujet, Message, NomFichier)
Else
    MsgBox "erreur envoi e_mail car outlook non chargé"
End If

End Sub


Sous outlook: (ThisOutlookSession)

Private Sub Application_Startup()
End Sub
Sub test2(Mail_liste, objet_message, texte_message, nom_pièce_jointe)

' la variable Mail_liste correspond au premier paramètre du call Call appli_Outlook.test2 (variable MailAd)
' la variable objet_message correspond au secon paramètre du call Call appli_Outlook.test2 (variable sujet)
' la variable texte_message correspond au troisième paramètre du call Call appli_Outlook.test2 (variable Message)
' la variable nom_pièce_jointe correspond au quatrième paramètre du call Call appli_Outlook.test2 (variable NomFichier)

On Error GoTo erreur_création_e_mail

' crée l'objet : e_mail
Set e_mail = Application.CreateItem(olMailItem)

' ajoute les destinataires
destinataires = Split(Mail_liste, ";")
    For i_destinataire = 0 To UBound(destinataires) - 1
    e_mail.Recipients.Add destinataires(i_destinataire)
Next i_destinataire

' remplit le sujet et le message
e_mail.Subject = objet_message
e_mail.Body = texte_message

'Attachement pièce jointe
If nom_pièce_jointe <> "" Then
    Set pièce_jointe = e_mail.Attachments
    pièce_jointe.Add NomFichier, olByValue, 1, nom_pièce_jointe
End If

' envoie l'e-mail
e_mail.Send

' fin traitement
création_mail_exit:
    Exit Sub

' routine erreur
erreur_création_e_mail:
    MsgBox "erreur envoi e-mail " & Err.Number & " " & Err.Description
    Resume création_mail_exit

End Sub

Sous Excel VBA:

Sub test1()

Workbooks("julieC - Irsem.xls").Activate
' Récupérer les mails des destinataires
Sheets("admin").Activate

'les adresses mail sont en colonne B
Set début_liste = Range("B1")
Set fin_liste = Range("B1").End(xlDown)
MailAd = Range(début_liste, fin_liste).Valuesujet = "Test envoi"
Message = "coucou, recevez-vous ce message?"
Call test2(MailAd, sujet, Message, NomFichier)

'choix pièce jointe
NomFichier = Application.GetOpenFilename

' appelle une sous-procédure Outlook VBA
Set appli_Outlook = Outlook.Application
If appli_Outlook.Explorers.Count > 0 Then
    Call appli_Outlook.test2(MailAd, sujet, Message, NomFichier)
Else
    MsgBox "erreur envoi e_mail car outlook non chargé"
End If

End Sub


Sous outlook: (ThisOutlookSession)

Private Sub Application_Startup()
End Sub
Sub test2(Mail_liste, objet_message, texte_message, nom_pièce_jointe)

' la variable Mail_liste correspond au premier paramètre du call Call appli_Outlook.test2 (variable MailAd)
' la variable objet_message correspond au secon paramètre du call Call appli_Outlook.test2 (variable sujet)
' la variable texte_message correspond au troisième paramètre du call Call appli_Outlook.test2 (variable Message)
' la variable nom_pièce_jointe correspond au quatrième paramètre du call Call appli_Outlook.test2 (variable NomFichier)

On Error GoTo erreur_création_e_mail

Set appli_Outlook = Outlook.Application


' crée l'objet : e_mail
Set e_mail = appli_Outlook.CreateItem(olMailItem)

' ajoute les destinataires
destinataires = Mail_liste
For i_destinataire = 1 To UBound(destinataires)
    e_mail.Recipients.Add destinataires(i_destinataire, 1)Next i_destinataire

' remplit le sujet et le message
e_mail.Subject = objet_message
e_mail.Body = texte_message

'Attachement pièce jointe
If nom_pièce_jointe <> "" Then
    Set pièce_jointe = e_mail.Attachments
    pièce_jointe.Add NomFichier, olByValue, 1, nom_pièce_jointe
End If

' envoie l'e-mail
e_mail.Send

' fin traitement
création_mail_exit:
    Exit Sub

' routine erreur
erreur_création_e_mail:
    MsgBox "erreur envoi e-mail " & Err.Number & " " & Err.Description
    Resume création_mail_exit

End Sub