VBA - outlook envoi de fichiers en PJ

Jouxte

XLDnaute Occasionnel
Bonjour à toutes et tous,

J'ai modifié un fichier de Jacques Boisgontier (que je remercie pour l'avoir mis à disposition) pour personnaliser chaque envoi.
Mes connaissances étant très limitées en VBA je ne réussi pas à faire fonctionner ce code correctement.
L'envoi ne se fait que pour la 1ère ligne.
Pourriez-vous regarder ce qui ne va pas.

Par avance merci.
 

Pièces jointes

  • Copie de Envoi.zip
    21.1 KB · Affichages: 79

JNP

XLDnaute Barbatruc
Re : VBA - outlook envoi de fichiers en PJ

Bonsoir Jouxte :),
Le problème est qu'avant de boucler, tu descends d'une ligne, mais tu ne reviens pas en colonne A. Modifie la fin de ta sub ainsi
Code:
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
      [COLOR=red][B]Cells(ActiveCell.Row + 1, 1).Select[/B][/COLOR]
    Loop
End Sub
Bonne soirée :cool:
 

Jouxte

XLDnaute Occasionnel
Re : VBA - outlook envoi de fichiers en PJ

Bonsoir JNP,

Toutes mes excuses pour ne pas avoir pu te répondre plus tôt mais le jeudi soir c'est soirée escrime.
Merci pour ce coup de pouce.
Tout fonctionne parfaitement.
 

Jouxte

XLDnaute Occasionnel
Re : VBA - outlook envoi de fichiers en PJ

Re,

Si je peux abuser, dans le même classeur j'ai une autre macro qui me permet d'envoyer en pièce jointe l'onglet Envoi.
Comment puis-je modifier le code ci-dessous pour que la macro accepte d'envoyer en PJ n'importe quel nom - dans le cas présent c'est Feuil1(Envoi) mais si je nomme l'onglet Test, je souhaite que le fichier créé prenne le nom de Test.xls
J'espère avoir été clair.
Par ailleurs y a-t-il moyen d'éviter que pour chaque ligne Outlook demande si l'envoi est autorisé ?

------------------------------------------------------------------------

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets("Envoi").Copy ' crée un classeur avec la feuille résultats
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Envoi.xls"
ActiveWindow.Close
'--- Envoi par mail
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
msg.Attachments.Add Source:=répertoireAppli & "\Envoi.xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
End Sub

---------------------------------------------------------------------------

D'avance merci
 

JNP

XLDnaute Barbatruc
Re : VBA - outlook envoi de fichiers en PJ

Bonjour Jouxte :),
Pour le choix de l'onglet, tu peux mettre une InputBox. Pour OutLook, de mémoire, il faut remplacer .send par .display, bien qu'il me semblait que c'était le contraire, mais tu auras quand même un petit message te demandant si tu autorises l'envoi. Pour ne pas avoir de message, il y a différentes solution que tu trouveras avec une petite recherche sur le forum, personnellement, je préfère garder le message plutôt que de me faire pirater par un troyen sans le savoir...
Code:
Sub envoi_Feuille()
[B][COLOR=#ff0000]Dim ChoixOnglet As String[/COLOR][/B]
[B][COLOR=#ff0000]ChoixOnglet = InputBox "Quel onglet dois-je envoyer ?"[/COLOR][/B]
répertoireAppli = ActiveWorkbook.Path ' Penser à Outils/Références Outlook
Sheets([B][COLOR=#ff0000]ChoixOnglet[/COLOR][/B]).Copy ' crée un classeur avec la feuille résultats
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\[B][COLOR=red]" & [/COLOR][COLOR=#ff0000]ChoixOnglet & "[/COLOR][/B].xls"
ActiveWindow.Close
'--- Envoi par mail
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
msg.Attachments.Add Source:=répertoireAppli & "\[COLOR=#ff0000][B]" & ChoixOnglet & "[/B][/COLOR].xls"
msg.[COLOR=red][B]Display[/B][/COLOR]
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Bonne journée :cool:
 

Jouxte

XLDnaute Occasionnel
Re : VBA - outlook envoi de fichiers en PJ

Bonjour JNP,

Bon je vois que mon message de ce matin n'est pas parti et en tout cas n'est pas arrivé.
Ce message pour te remercier de ton aide précieuse et te dire que bien évidemment tout fonctionne parfaitement.
En ce qui concerne les messages d'alerte d'Outlook, dans le temps une boite de dialogue me posait la question de savoir si c'était bien moi qui avait déclenché Outlook et il me demandait combien de temps j'autorisais l'accès.
Maintenant c'est pour chaque courrier généré par Excel.
Je vais fouiller dans le forum voir ce que je trouve.
 

Discussions similaires

Réponses
22
Affichages
2 K