Diffusion mail + PDF via VBA

Le 15/01/2021 à 10:59

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 ?

6envoi-attestation-v2-3.xlsm (28.31 Ko)

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

Le 15/01/2021 à 12:18

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
Le 15/01/2021 à 12:26

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?

Rechercher des sujets similaires à "diffusion mail pdf via vba"