Microsoft 365 HELP VBA Mail excell Outlook / Fichier Joint + Copie

[Gom77]

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.

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

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

 

[danielco]

Bonjour,

Pourrais-tu expliquer ce que tu cherches à faire ? Parce que, pour un débutant, tu écris du code avec des commentaires en anglais ;-)

Cordialement.

Daniel

 

[Gom77]

J'ai repris une macro que j'ai trouvé sur internet et j'aimerais l'améliorer.

En gros je cherche à faire un envoi de masse par mail (Outlook) via un fichier excell avec corps du mail dans une cellule, objet dans une cellule, une liste de contact avec une pièce jointe distincte pour chaque contact donc avec un chemin d'accès. Et si il ne trouve pas de pièce jointe il n'envoi pas le mail à ceux où il ne trouve pas mais il envoi à ceux où il trouve le fichier.

Bonjour,

Pourrais-tu expliquer ce que tu cherches à faire ? Parce que, pour un débutant, tu écris du code avec des commentaires en anglais ;-)

Cordialement.

Daniel

 

[danielco]

Essaie :

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 And tabFNames(i, 1) <> "" 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



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

Daniel

 

[Gom77]

Essaie :

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 And tabFNames(i, 1) <> "" 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



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

Daniel

Non malheureusement ça ne fonctionne pas, ça me met ce message :

 

[danielco]

Quand tu cliques sur "Débogage", quelle est la ligne surlignée en jaune ? Si c'est :

.Attachments.Add (strFName)

C'est que le nom ou le chemin du fichier indiqué dans la variable "strFName" est incorrect. Quand tu as le message d'erreur, passe la souris sur le nom de la variable pour connaître sa valeur.

Daniel