Diffusion mail + PDF via VBA
Bonjour,
J'ai une erreur sur cette macro pour envoyer via un fichier excel et via cette VBA un mail à 500 personnes avec PDF.
Elle bloque autour du 24/25ème envoi alors que l'objet du mail, le corps du mail est le même pour tous, seul le PDF change. en fonction du nom inscrit dans le fichier PDF.
Pouvez-vous m'aider ?
Sub envoi_mail()
Dim i As Integer
Dim OutlookApp
Dim OutlookMail
With Sheets(1)
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row ' on passe en revue toutes les lignes de la colonne A
'mise en mémoire adresse mail
adresse = ""
If Range("J" & i) <> "" And Range("K" & i) = "" Then adresse = Range("J" & i)
If Range("J" & i) <> "" And Range("K" & i) <> "" Then adresse = Range("J" & i) & ";" & Range("K" & i)
If Range("J" & i) = "" And Range("K" & i) <> "" Then adresse = Range("K" & i)
'mise en mémoire le nom du fichier a rechercher
nomfic = Range("L" & i)
If Dir(nomfic) <> "" And adresse <> "" Then
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.createitem(0)
With OutlookMail
.Subject = Range("M" & i) 'sujet du mail
.To = adresse 'adresse mail destinataire
.body = Range("N" & i) & vbCr & Range("O" & i) 'corps du message
.Attachments.Add nomfic 'attache le fichier au mail
'.Display
.send 'on envoie le mail créé
End With
End If
Next i 'on passe au mail suivant
End With
End
Bonjour,
Pas testé !...
Sub envoi_mail()
Dim i As Long
Dim OutlookApp As Object, OutlookMail As Object
Dim adresse As String, nomfic As String
Set OutlookApp = CreateObject("outlook.application")
With Sheets(1)
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row ' on passe en revue toutes les lignes de la colonne A
'mise en mémoire adresse mail
adresse = ""
If .Range("J" & i) <> "" And .Range("K" & i) = "" Then adresse = .Range("J" & i).Value
If .Range("J" & i) <> "" And .Range("K" & i) <> "" Then adresse = .Range("J" & i).Value & ";" & .Range("K" & i).Value
If .Range("J" & i) = "" And .Range("K" & i) <> "" Then adresse = .Range("K" & i).Value
'mise en mémoire le nom du fichier a rechercher
nomfic = Range("L" & i).Value
If Dir(nomfic) <> "" And adresse <> "" Then
Set OutlookMail = OutlookApp.createitem(0)
With OutlookMail
.Subject = Range("M" & i).Value 'sujet du mail
.To = adresse 'adresse mail destinataire
.body = Range("N" & i).Value & vbCr & Range("O" & i).Value 'corps du message
.Attachments.Add nomfic 'attache le fichier au mail
'.Display
.send 'on envoie le mail créé
End With
Set OutlookMail = Nothing
End If
Next i 'on passe au mail suivant
End With
Set OutlookApp = Nothing
End Sub
Bonjour,
Merci de votre retour. Je viens de tester mais la macro bug au moment d'attacher le fichier PDF :
.Attachments.Add nomfic 'attache le fichier au mail
Savez-vous pourquoi?