VBA L'envoi ne se fait que pour la 1ère ligne.

novice_en_vba

XLDnaute Nouveau
Bonjour,

je souhaite envoyer des états pdfs via un fichier excel qui récence les mails et les fichiers à envoyer
j ai récupéré la macro ci dessous
Elle fonctionne au problème prêt qu'elle envoie seulement la première ligne
Pourriez vs svp m'aider ?
merci
Sub envoiPJ_Fichier()

Dim olapp As Outlook.Application
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = ActiveCell.Offset(0, 1).Value & " " & ActiveCell.Offset(0, 2).Value & " " & ActiveCell.Offset(0, 3).Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 4).Value & Chr(13) & Range("A5").Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 5).Value & Chr(13) & Range("A8").Value
'-- pj
ActiveCell.Offset(0, 6).Select
Do While Not IsEmpty(ActiveCell)
nf = ActiveWorkbook.Path & "\" & ActiveCell.Value
msg.Attachments.Add Source:=nf
ActiveCell.Offset(0, 1).Select
Loop
msg.Display
Loop
End Sub
 

novice_en_vba

XLDnaute Nouveau
hello

merci pour ton aide mais
ca bug erreur d'exécution 446 : cet objet ne gère pas les arguments nommées
au niveau "msg.Attachments.Add Source:=nf"

nvelle macro après modif
Sub envoiPJ_Fichier()

Dim olapp As Outlook.Application
Sheets("destinataires").Select
Range("A11").Select
Do While Not IsEmpty(ActiveCell)
Dim msg As Object
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("A2").Value
msg.Body = ActiveCell.Offset(0, 1).Value & " " & ActiveCell.Offset(0, 2).Value & " " & ActiveCell.Offset(0, 3).Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 4).Value & Chr(13) & Range("A5").Value & Chr(13) & Chr(13) & ActiveCell.Offset(0, 5).Value & Chr(13) & Range("A8").Value
'-- pj
ActiveCell.Offset(0, 6).Select
Do While Not IsEmpty(ActiveCell)
nf = ActiveWorkbook.Path & "\" & ActiveCell.Value
msg.Attachments.Add Source:=nf
ActiveCell.Offset(0, 1).Select
Loop
msg.Display

Loop
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 634
Messages
2 111 435
Membres
111 136
dernier inscrit
Ahmad Ibnou