Problème VBA envoie mail
Bonjour,
Depuis le passage sous office 365, je n'arrive plus à envoyer de mail à un seul dentinaire. Avant j'arrivais à envoyer au 4 personnes qui sont renseignées des les cellules. Quelqu'un à une idée ? Merci d'avance
Sub Send_Mails()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("nom du fichier")
Dim i As Integer
Dim OA As Object
Dim msg As Object
Set OA = CreateObject("outlook.application")
Dim Dp As Integer
Dp = Application.CountA(sh.Range("A:A"))
For i = 2 To Dp
Set msg = OA.createitem(0)
msg.To = sh.Range("D" & i).Value
msg.To = sh.Range("A" & i).Value
msg.To = sh.Range("B" & i).Value
msg.To = sh.Range("C" & i).Value
msg.Subject = sh.Range("E" & i).Value
msg.body = sh.Range("F" & i).Value
If sh.Range("E" & i).Value <> "" Then
msg.attachments.Add sh.Range("G" & i).Value
msg.attachments.Add sh.Range("H" & i).Value
End If
msg.send
Next i
'message de fin
MsgBox "les mails sont envoyés avec succès"
End Sub
Bonjour,
Le mail est envoyé à qu'un seul destinataire ou vous n'arrivez plus à l'envoyer ? On ne comprend pas bien.
Normalement, les destinataires sont séparés par des ";". Dans votre cas, seul le dernier est conservé. Voici un essai d'adaptation :
Sub Send_Mails()
Dim OA as object, msg as object, sh As Worksheet, i%, Dp%
Set sh = ThisWorkbook.Sheets("nom du fichier")
Set OA = CreateObject("outlook.application")
Dp = Application.CountA(sh.Range("A:A"))
For i = 2 To Dp
Set msg = OA.createitem(0)
with msg
.To = join(application.transpose(application.transpose(sh.Range("A:D").rows(i).Value)), ";")
.body = sh.Range("F" & i).Value
If sh.Range("E" & i).Value <> "" Then
.Subject = sh.Range("E" & i).Value 'penser à un sujet par défaut
.attachments.Add sh.Range("G" & i).Value
.attachments.Add sh.Range("H" & i).Value
End If
.send
end with
Next i
'MsgBox "les mails sont envoyés avec succès"
End Sub
Cdlt,
Bonjour,
Merci, ta macro marche à merveille !!!
Bonne journée