cibleo
XLDnaute Impliqué
Bonsoir le forum,
Voilà, j'ai voulu adapter un exemple de JNP pour sélectionner les destinataires de mes mails.
https://www.excel-downloads.com/threads/macro-pour-coller-adresses-mail-dans-outlook.127369/
Dans la feuille de calcul "MesDestinataires", le choix des destinataires de mes mails s'effectue donc en cochant la colonne C puis en y appliquant un filtre.
Le code qui appelle la procédure ci-dessous (Feuille "01 01 10")
La partie en bleu crée le PDF, ça fonctionne (repris sur le forum)
La sélection de mes destinataires ne fonctionne pas, je dois avoir un souci au niveau .To = ListeMail
J'ai ce message d'erreur.
Si je cite explicitement le destinataire comme ceci .To = "totoche@orange.fr"
Le code fonctionne normalement (je me le suis envoyé à moi-même)
Ai-je un problème avec la boucle While Wend ou avec l'argument passé
ListeMail ?
Dans l'exemple, j'aimerais envoyer un mail à Samuel et Philippe et non à Bernard.
Pouvez-vous m'aider ?
Ci-joint le fichier.
Bonne soirée Cibleo
Voilà, j'ai voulu adapter un exemple de JNP pour sélectionner les destinataires de mes mails.
https://www.excel-downloads.com/threads/macro-pour-coller-adresses-mail-dans-outlook.127369/
Dans la feuille de calcul "MesDestinataires", le choix des destinataires de mes mails s'effectue donc en cochant la colonne C puis en y appliquant un filtre.
Le code qui appelle la procédure ci-dessous (Feuille "01 01 10")
Code:
Private Sub CommandButton1_Click()
Call [COLOR=red]EnvoyerMailEtPDF[/COLOR](([COLOR=darkgreen]ListeMail[/COLOR]))
ThisWorkbook.Saved = True
End Sub
La partie en bleu crée le PDF, ça fonctionne (repris sur le forum)
Code:
Sub [COLOR=red]EnvoyerMailEtPDF[/COLOR]([COLOR=darkgreen]ListeMail[/COLOR] As String)
'Dim objMessage As Object
Dim objMessage As CDO.Message
'Dim JobPDF As PDFCreator.clsPDFCreator
Dim JobPDF As Object 'liaison tardive
Dim sNomPDF As String
Dim sCheminPDF As String
sNomPDF = ActiveSheet.Cells(1, 2).Value & ".pdf"
sCheminPDF = "C:\Users\Windows Vista\Documents\cibleo\Version FinalePlanning\"
'Set JobPDF = New PDFCreator.clsPDFCreator
Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
[COLOR=blue]With JobPDF[/COLOR]
[COLOR=blue]'La condition ci-dessous empêche l'ouverture de la boite de dialogue de PDFCreator[/COLOR]
[COLOR=blue]If .cStart("/NoProcessingAtStartup") = False Then[/COLOR]
[COLOR=blue]MsgBox "Can't initialize PDFCreator.", vbCritical + _[/COLOR]
[COLOR=blue]vbOKOnly, "PrtPDFCreator"[/COLOR]
[COLOR=blue]Exit Sub[/COLOR]
[COLOR=blue]End If[/COLOR]
[COLOR=blue].cOption("UseAutosave") = 1[/COLOR]
[COLOR=blue].cOption("UseAutosaveDirectory") = 1[/COLOR]
[COLOR=blue].cOption("AutosaveDirectory") = sCheminPDF[/COLOR]
[COLOR=blue].cOption("AutosaveFilename") = sNomPDF[/COLOR]
[COLOR=blue].cOption("AutosaveFormat") = 0 ' 0 = PDF[/COLOR]
[COLOR=blue].cClearCache[/COLOR]
[COLOR=blue]End With[/COLOR]
[COLOR=blue]'Convertit le document en PDF[/COLOR]
[COLOR=blue]ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"[/COLOR]
[COLOR=blue]'Attend que le document soit entré dans la file de Création[/COLOR]
[COLOR=blue]Do Until JobPDF.cCountOfPrintjobs = 1[/COLOR]
[COLOR=blue]DoEvents[/COLOR]
[COLOR=blue]Loop[/COLOR]
[COLOR=blue]JobPDF.cPrinterStop = False[/COLOR]
[COLOR=blue]'Attend que la Création du document PDF soit terminée[/COLOR]
[COLOR=blue]Do Until JobPDF.cCountOfPrintjobs = 0[/COLOR]
[COLOR=blue]DoEvents[/COLOR]
[COLOR=blue]Loop[/COLOR]
[COLOR=blue]JobPDF.cClose[/COLOR]
[COLOR=blue]Set JobPDF = Nothing[/COLOR]
[COLOR=red]'---- Création et envoi message ------------[/COLOR]
Set objMessage = New CDO.Message
'Set objMessage = CreateObject("CDO.Message")
With objMessage
.Subject = "Envoi Planning du jour" ' Sujet du mail
.From = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
'.To = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
'.To = "[EMAIL="totoche@orange.fr"]totoche@orange.fr[/EMAIL]"
[B][COLOR=darkred].To = ListeMail[/COLOR][/B]
'.BCC = ListeMail
'.BCC = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
' Corps du mail
.TextBody = "Bonjour à tous," & _
vbCrLf & vbCrLf & _
"Ceci est un essai" & _
vbCrLf & _
"Vous trouverez ci-joint le " & [B1].Value & _
vbCrLf & vbCrLf & _
"Cordialement Sylvie" & _
vbCrLf & vbCrLf & _
"Jojo, peux-tu me dire si mon mail du 12.02 est bien passé ainsi que la pièce jointe" & _
vbCrLf & vbCrLf & _
"Cibleo"
.AddAttachment sCheminPDF & sNomPDF ' Fichier joint au mail
' Send et Display ne doivent pas être utiliser simultanément
.Send '<<<<<<<<<<<<<<<Pour envoyer directement
'.Display '<<<<<<<<<<<<<Pour voir le mail avant envoi
End With
Set objMessage = Nothing
End Sub
Code:
Sub ListeDestinataires()
Dim I As Integer, [COLOR=darkgreen]ListeMail[/COLOR] As String
I = 2 ' ligne de la première adresse
With Sheets("MesDestinataires")
While .Cells(I, 2) <> "" ' tant que la colonne 2 et sur la ligne I n'est pas vide
If Not Intersect(Cells(I, 2).SpecialCells(xlCellTypeVisible), Cells(I, 2)) Is Nothing Then ' si la cellule précitée est visible
[COLOR=darkgreen]ListeMail[/COLOR] = [COLOR=darkgreen]ListeMail[/COLOR] & ";" & Cells(I, 2) ' je l'ajoute à la liste
End If
I = I + 1 ' je regarde la ligne suivante
Wend
End With
[COLOR=red]EnvoyerMailEtPDF[/COLOR] ([COLOR=darkgreen]ListeMail[/COLOR]) ' j'envoie la liste à la sub d'envoi
End Sub
La sélection de mes destinataires ne fonctionne pas, je dois avoir un souci au niveau .To = ListeMail
J'ai ce message d'erreur.
Si je cite explicitement le destinataire comme ceci .To = "totoche@orange.fr"
Le code fonctionne normalement (je me le suis envoyé à moi-même)
Ai-je un problème avec la boucle While Wend ou avec l'argument passé
ListeMail ?
Dans l'exemple, j'aimerais envoyer un mail à Samuel et Philippe et non à Bernard.
Pouvez-vous m'aider ?
Ci-joint le fichier.
Bonne soirée Cibleo