Bonjour,
J'ai besoin de votre aide, je suis novice dans l'utilisation de macro VBA et j'ai besoin d'une solution.
Je cherche a rajouter une notion : Si il ne trouve pas de fichier à joindre il n'envoi pas de mail au contact où le fichier est manquant, mais qu'il envoi quand même à ceux où il trouve un fichier correspondant.
J'aimerais également rajouter une colonne où il y aurait les contacts à mettre en copie, et rajouter la donnée qui se trouve dans cette colonne dans le code CC, j'ai essayé mais je n'y suis pas parvenue.
Merci à vous.
J'ai besoin de votre aide, je suis novice dans l'utilisation de macro VBA et j'ai besoin d'une solution.
Je cherche a rajouter une notion : Si il ne trouve pas de fichier à joindre il n'envoi pas de mail au contact où le fichier est manquant, mais qu'il envoi quand même à ceux où il trouve un fichier correspondant.
J'aimerais également rajouter une colonne où il y aurait les contacts à mettre en copie, et rajouter la donnée qui se trouve dans cette colonne dans le code CC, j'ai essayé mais je n'y suis pas parvenue.
Merci à vous.
VB:
Option Explicit
Private OL_App As Object
Private OL_Mail As Object
Private sSubject As String, sBody As String
Sub SendDocuments()
' Generate e-mails to be sent to a list of mail recipients, with a customized attachment and message for each person
Dim i As Long
Dim tabContactNames As Variant, tabContactEmails As Variant, tabFNames As Variant
' Init
Application.ScreenUpdating = False
' Open Outlook
On Error Resume Next
Set OL_App = GetObject(, "Outlook.Application")
If OL_App Is Nothing Then
Set OL_App = CreateObject("Outlook.Application")
End If
On Error GoTo 0
' Read E-mail parameters
sSubject = Range("C6").Value
sBody = Range("C8").Value
' Read Contact list
tabContactNames = Range("C16:C25").Value
tabContactEmails = Range("D16:D25").Value
tabFNames = Range("E16:E25").Value
' Generate e-mails
For i = 1 To UBound(tabContactNames, 1)
If tabContactNames(i, 1) <> vbNullString Then
Call CreateNewMessage(tabContactNames(i, 1), tabContactEmails(i, 1), tabFNames(i, 1))
End If
Next i
MsgBox "The process has been entirely completed."
Set OL_App = Nothing
Set OL_Mail = Nothing
Application.ScreenUpdating = True
End Sub
Code:
Private Sub CreateNewMessage(strContactName, strContactTo, strFName)
' Create a new message with the following inputs :
Set OL_Mail = OL_App.CreateItem(0)
With OL_Mail
.To = strContactTo
'.CC = "test@domain1.com"
.Subject = sSubject
.Body = sBody
.BodyFormat = 1 'Format : 0=undetermined; 1=plain text; 2= HTML; 3=rich text
.Importance = 2 'Importance : 0=low; 1=normal; 2= high
.Sensitivity = 3 'Confidentiality : 0=normal; 1=personal; 2=private; 3=confidential
.Attachments.Add (strFName)
' Display or send the message
.Display
'.Send
End With
Set OL_Mail = Nothing
End Sub