Excel VBA Erreur lors d'une boucle --> Macro Envoi automatique PDF via Outlook

[Oulol]

Bonjour à toutes et tous,

Et premièrement merci de votre présence et votre précieuse aide.

Je dispose dans un dossier des fichiers PDF et j'ai constitué via Excel un tableau permettant de lister pour chaque fichier un/ou plusieurs destinataires.

Avec une macro je souhaite donc automatiser l'envoi de ces fichiers via Outlook avec la liste des personnes indiquées dans le tableau. J'ai donc procédé à une boucle mais celle-ci plante après le premier passage. Un message d'erreur m'indique "L'élément a été déplacé ou supprimé"

Je vous joins le code utilisé:

Sub Send_Mail_Outlook()

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"

Dim ObjOutlook As New Outlook.Application
'Dim ObjOutlookmail As MailItem
'Dim NomFichier As String
Dim oBjMail
'Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'Dans ton cas changer par du Pdf ou mettre directement le chemin et nom du fichier pdf dans Nom_Fichier

fin1 = Range("a1").End(xlDown).Row

For i = 2 To fin1

Nom_Fichier = Feuil2.Range("f" & i).Value
Chemin = Feuil2.Range("g" & i).Value

'If Nom_Fichier = "Faux" Then Exit Sub
'If VarType(Nom_Fichier) = vbBoolean Then Exit Sub

'With oBjMail

oBjMail.To = Feuil2.Range("h" & i).Value
oBjMail.Cc = Feuil2.Range("i" & i).Value 'copie
oBjMail.Subject = Feuil2.Range("b" & i).Value ' l'objet du mail
oBjMail.Body = Feuil2.Range("c" & i).Value 'le corps du mail ..son contenu
oBjMail.Attachments.Add Chemin '"C:\Data\essai.txt" ' ou Nomfichier
oBjMail.Display ' Ici on peut supprimer' pour l'envoyer sans vérification
oBjMail.Send

'End With

Next

'ObjOutlook.Quit



End Sub



Je vous joins également le fichier Excel


Merci d'avance je me tire les cheveux depuis hier dessus..

 

[camarchepas]

Re : Excel VBA Erreur lors d'une boucle --> Macro Envoi automatique PDF via Outlook

Bonjour,

Oups , j'ai envoyer un mail par erreur lors des essais.

Tu devrais enlever les données confidentielles de ton fichier ....

Bon , lorsque l'on enregistre le fichier qui contient des macros , il faut changer l'extension du fichier en XLSM.

sinon l'on perd les macros .

Bon voici donc le code testé répondant à priori à tes besoins:

Sub Send_Mail_Outlook()

'Il faut activer la référence "Microsoft Outlook Library" Avant de lancer cette macro,
' Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"

 Dim ObjOutlook As Outlook.Application
 Dim oBjMail As Outlook.MailItem
 Dim Fin1 As Long, I As Long
 Dim Nom_Fichier As String, Chemin As String
 Set ObjOutlook = New Outlook.Application

 'Dans ton cas changer par du Pdf ou mettre directement le chemin et nom du fichier pdf dans Nom_Fichier

 Fin1 = Range("a" & Rows.Count).End(xlUp).Row

 For I = 2 To Fin1
 Set oBjMail = ObjOutlook.CreateItem(olMailItem)
 Nom_Fichier = Feuil2.Range("f" & I).Value
 Chemin = Feuil2.Range("g" & I).Value

 'If Nom_Fichier = "Faux" Then Exit Sub
 'If VarType(Nom_Fichier) = vbBoolean Then Exit Sub

 With oBjMail

 .To = Feuil2.Range("h" & I).Value
 .Cc = Feuil2.Range("i" & I).Value 'copie
 .Subject = Feuil2.Range("b" & I).Value ' l'objet du mail
 .Body = Feuil2.Range("c" & I).Value 'le corps du mail ..son contenu
 .Attachments.Add Chemin ' ou Nomfichier"
 .Display ' Ici on peut supprimer' pour l'envoyer sans vérification
 .Send

 End With
Set oBjMail = Nothing
 Next

 'ObjOutlook.Quit



 End Sub

 

[Oulol]

Re : Excel VBA Erreur lors d'une boucle --> Macro Envoi automatique PDF via Outlook

Je te remercie tout fonctionne super!
Bonne fin de journée