web-dev-qa-db-fra.com

Comment puis-je utiliser Outlook pour envoyer des e-mails à plusieurs destinataires dans Excel VBA

J'essaie de configurer plusieurs boutons sur un formulaire Excel pour envoyer des courriers électroniques à différents groupes de personnes. J'ai créé plusieurs plages de cellules sur une feuille de calcul distincte pour répertorier les adresses e-mail distinctes. Par exemple, je souhaite que le "bouton A" ouvre Outlook et mette la liste des adresses e-mail de la "feuille de calcul B: cellules D3-D6". Ensuite, tout ce qui doit être fait est de cliquer sur "Envoyer" dans Outlook.

Voici mon code VBA jusqu'à présent, mais je ne peux pas le faire fonctionner. Quelqu'un peut-il me dire ce qui me manque ou ce que je fais mal, s'il vous plaît?

VB:

Sub Mail_workbook_Outlook_1() 
     'Working in 2000-2010
     'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object 
    Dim OutMail As Object 

    EmailTo = Worksheets("Selections").Range("D3:D6") 

    Set OutApp = CreateObject("Outlook.Application") 
    Set OutMail = OutApp.CreateItem(0) 

    On Error Resume Next 
    With OutMail 
        .To = EmailTo 
        .CC = "[email protected];[email protected]" 
        .BCC = "" 
        .Subject = "RMA #" & Worksheets("RMA").Range("E1") 
        .Body = "Attached to this email is RMA #" & Worksheets("RMA").Range("E1") & ". Please follow the instructions for your department included in this form." 
        .Attachments.Add ActiveWorkbook.FullName 
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")

        .Display 
    End With 
    On Error Goto 0 

    Set OutMail = Nothing 
    Set OutApp = Nothing 
End Sub
excelemailvbaoutlook
9
user2092180

Vous devez parcourir chaque cellule de la plage "D3:D6" et construisez votre chaîne To. L'affecter simplement à une variante ne résoudra pas le but. EmailTo devient un tableau si vous lui affectez directement la plage. Vous pouvez également le faire, mais vous devrez ensuite parcourir le tableau pour créer votre chaîne To

C'est ce que vous essayez? (ESSAI ET TESTÉ)

Option Explicit

Sub Mail_workbook_Outlook_1()
     'Working in 2000-2010
     'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailRng As Range, cl As Range
    Dim sTo As String

    Set emailRng = Worksheets("Selections").Range("D3:D6")

    For Each cl In emailRng 
        sTo = sTo & ";" & cl.Value
    Next

    sTo = Mid(sTo, 2)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = "[email protected];[email protected]"
        .BCC = ""
        .Subject = "RMA #" & Worksheets("RMA").Range("E1")
        .Body = "Attached to this email is RMA #" & _
        Worksheets("RMA").Range("E1") & _
        ". Please follow the instructions for your department included in this form."
        .Attachments.Add ActiveWorkbook.FullName
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
14
Siddharth Rout
ToAddress = "[email protected]"
ToAddress1 = "[email protected]"
ToAddress2 = "[email protected]"
MessageSubject = "It works!."
Set ol = CreateObject("Outlook.Application")
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.RecipIents.Add(ToAddress)
newMail.RecipIents.Add(ToAddress1)
newMail.RecipIents.Add(ToAddress2)
newMail.Send
4
MD5