XL 2010 MACRO Envoyer fichiers pdf par mail à différents destinataires

Doddie · 17 Juin 2016

Bonjour,

Novice sur le forum et en macro, je vous demande par avance de m'excuser si je n'utilise pas les termes les plus justes.

J'ai un classeur excel sur lequel j'applique la macro suivante pour créer des fichiers PDF :

Sub sauvegarderPDF()
' impression de toutes les fiches en PDF

Dim lignedep As Long

lignedep = 96

Index = lignedep

While chemin = ""
'ouvre une boite de dialogue pour choisir un répertoire
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
chemin = .SelectedItems(1)
End If
End With
Wend

'On vérifie si le dernier caractère est différent de "\"
If Right(chemin, 1) <> "\" Then
chemin = chemin & "\"
End If

'Boucle sur la liste des directions
While Worksheets("synthese").Cells(Index, 3).Value <> ""

'on renseigne B1 avec la valeur
Range("b1").Value = Cells(Index, 3).Value

NomFichier = Range("b1").Value & "- NOM DU FICHIER"

'on enregistre en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
chemin & NomFichier & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

'on passe à la ligne suivante
Index = Index + 1
Wend

End Sub

Aujourd'hui je "m'amuse" à envoyer chaque fichier généré à un/des correspondants différents.

J'aurai souhaité mettre en place une macro qui me faciliterai la tâche et générerai les mails "automatiquement".

Sachant que les noms des fichiers PDF débutent par la valeur de la cellule B1 qui est le nom du service auquel je doit adresser le PDF et qu'à ce nom correspondent des correspondants différents.
Pour essayer d'être clair, je dois envoyer le fichier DRH-NOM DU FICHIER à isabelle.dupont@truc.fr, le fichier DAF-NOM DU FICHIER à Patrick.durand@bidule.com etc

Je vous remercie d'avance pour votre aide et vous souhaite un bon week-end

max.lander · 17 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

Bonjour à tous,

Tu utilises quoi comme messagerie?

Max

Doddie · 17 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

Bonjour,
J'utilise Outlook

max.lander · 18 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

Salut,

Un exemple de code non testé à modifier selon tes souhaits, c'est plus simple si tu ajoutes un fichier exemple !

A+

Code:

Sub Send_Mail()


Dim Destinataire As MailFormat
Dim Selection As String


Selection = ActiveSheet.Range("b1").Value

Select Case Selection

Case Is = "DAF"
Destinataire = "Monique@bidulemail.com"

Case Is = "DRH"

Destinataire = "Karim@bidulemail.com"


End Select



Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
   
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
 
'---------------------------------------------------------
     With oBjMail
        .To = Destinataire
       .Subject = "Monobjet"          'objet  mail
       .Body = "Mon message"  'le corps du mail
       .Attachments.Add chemin & NomFichier & ".pdf"

       .Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Sub

Doddie · 19 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

Merci pour ton aide !
J'essayerai ça demain !
Par contre, ce qui, a priori, me pose problème dans ce code c'est le "in case" parce qu'en gros j'ai une liste d'une centaine de service avec une centaine de nom en face du coup je peux pas mettre toutes les éventualités dans mon code... J'aurai préféré pouvoir pointer sur un tableau excel où j'ai les infos par exemple...

max.lander · 19 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

ajoute un fichier exemple ça sera plus simple !

Doddie · 19 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

C'est malheureusement un fichier pro, je ne peux donc pas le mettre en ligne...
En fait j'ai un second fichier excel qui recense le nom des services avec les mails des destinataires correspondants. L'idéal serai donc que le code d'envoi aille pointer sur cette liste.
Dans mon langage ça donnerai :
Si le nom du fichier à envoyer commence par DAF alors chercher dans la colonne A du second fichier et envoyer à l'adresse indiquée colonne B.

Je ne sais pas si c'est réalisable...

Doddie · 20 Juin 2016

Re : MACRO Envoyer fichiers pdf par mail à différents destinataires

Et bien à force de recherches sur différents forums et de tests, j'ai réussi à faire quelque chose de convenable.
Ce code reprend le code que j'utilise pour mettre le fichier en pdf et ajoute la partie envoi de mail.

Je mets le code trouvé ici pour les suivants :

Sub EnvoiAutomatiqueMail()
Dim lignedep As Long
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim adresse As String
Dim message As String
Dim sujet As String

lignedep = 96
Index = lignedep

While chemin = ""
'ouvre une boite de dialogue pour choisir un répertoire
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
chemin = .SelectedItems(1)
End If
End With
Wend

'On vérifie si le dernier caractère est différent de "\"
If Right(chemin, 1) <> "\" Then
chemin = chemin & "\"
End If

'Boucle sur la liste des directions
While Worksheets("synthese").Cells(Index, 3).Value <> ""

'on renseigne B1 avec la valeur
Range("b1").Value = Cells(Index, 3).Value

'on nomme le fichier
NomFichier = Range("b1").Value & "- NOM DU FICHIER"

'on enregistre en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
chemin & NomFichier & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

CurFile = chemin & NomFichier & ".pdf"

'on définit le sujet du mail
sujet = Range("b1").Value & " - SUJET DU MAIL"

'on pointe sur la cellule contenant l'adresse
adresse = Range("b92")
copie = Range("b93")

'on rédige le mesage
message = " Bonjour," & vbCrLf & "Veuillez trouver ci-joint le fichier "
'VBCRLF permet un retour à la ligne ‘VBCRLF permet un passage à la ligne dans le mail envoyé.

Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Subject = sujet
.To = adresse
.CC = copie
' CC ne doit pas être nul
.Body = message
.Attachments.Add CurFile
.Send
'on envoie le mail créé / peut être remplacé par .display pour préparer le mail sans l'envoyer
End With
'on passe à la ligne suivante
Index = Index + 1
Wend
End Sub

J'ai finalement fait apparaitre le mail du destinataire sur ma feuille au moyen d'un RECHERCHEV afin de simplifier la démarche. Comme je l'ai mis hors de la zone d'impression, ça n'apparait pas sur le fichier envoyé donc pas gênant.

Merci d'avoir répondu à mon appel à l'aide en tout cas !

XL 2010 MACRO Envoyer fichiers pdf par mail à différents destinataires

Doddie

XLDnaute Nouveau

max.lander

XLDnaute Occasionnel

Doddie

XLDnaute Nouveau

max.lander

XLDnaute Occasionnel

Doddie

XLDnaute Nouveau

max.lander

XLDnaute Occasionnel

Doddie

XLDnaute Nouveau

Doddie

XLDnaute Nouveau

Discussions similaires