Problème avec While wend ou avec l'argument passé

[cibleo]

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")

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)

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

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

 

[Modeste]

Re : Problème avec While wend ou avec l'argument passé

Bonsoir cibleo, le forum,

Sauf erreur, je pense que ton bouton devrait appeler l'autre procédure: ListeDestinataires()
D'autre part, dans cette même procédure, il me semble que j'ajouterais des '.' devant les 'Cells(I, 2) puisqu'il y a un With Sheets ... en tout cas, en appliquant le filtre, ça a l'air de fonctionner (ListeMail se garnit comme tu le voulais)
... Bon, tout ceci sous réserve que j'aie bien compris mais je ne peux pas tester le reste (pas de PDFCreator installé)

 

[Staple1600]

Re : Problème avec While wend ou avec l'argument passé

Bonsoir


Par sécurité, remplacer
Dim I As Integer

par

Dim I As Long

 

[youky(BJ)]

Re : Problème avec While wend ou avec l'argument passé

Bonjour,
La variable ListeMail change de procédure et doit être déclarée en tête de Module
Exemple:
Public ListMail as String
ou
Dim ListMail as String

A+
Bruno

 

[cibleo]

Re : Problème avec While wend ou avec l'argument passé

Bonsoir le forum,
Bonsoir youky(BJ), Staple1600, Modeste

J'ai suivi vos conseils.

Comme çà, c'est déjà mieux Modeste

Private Sub CommandButton1_Click()
Call [B][COLOR=navy]ListeDestinataires[/COLOR][/B]
ThisWorkbook.Saved = True
End Sub

Puis j'ai rajouté un point comme indiqué ci-dessous en rouge.

Sub [B][COLOR=navy]ListeDestinataires[/COLOR][/B]()
Dim I As Long, [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=black][B][COLOR=darkgreen]ListeMail [/COLOR]= [COLOR=darkgreen]ListeMail[/COLOR] & ";" &[/B] [COLOR=red][B].Cells(I, 2)[/B][/COLOR][/COLOR] ' je l'ajoute à la liste
        End If
        I = I + 1 ' je regarde la ligne suivante
      Wend
    End With
 
    [B]EnvoyerMailEtPDF[/B] ([COLOR=darkgreen]ListeMail[/COLOR]) ' j'envoie la liste à la sub d'envoi
End Sub

Sub [B]EnvoyerMailEtPDF[/B]([COLOR=darkgreen]ListeMail[/COLOR] As String)
'Dim objMessage As Object
Dim objMessage As CDO.Message
 
.../...
 [COLOR=darkred][B]'---- Création et envoi message ------------[/B][/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]"
        [COLOR=darkgreen][B].To = ListeMail[/B][/COLOR]
        ' Corps du mail
        .TextBody = "Bonjour à tous," & _
        vbCrLf & vbCrLf & _
        "Ceci est un essai"
.../...
         .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

Je n'ai plus d'erreur d'exécution, mais adresses Mails sont bien renvoyés dans la variable ListeMail.

Problème : toutes les adresses mails de la colonne B (feuille : MesDestinataires) y sont renvoyées.

J'aimerais que seules les adresses qui sont cochées en colonne C soient renvoyées dans la variable ListeMail.

Pouvez-vous m'aider à modifier la boucle while wend.

Cibleo

 

[Modeste]

Re : Problème avec While wend ou avec l'argument passé

Salut à tous,

ici, tu as encore des Cells(I,2):

If Not Intersect([COLOR="Red"][B].[/B]Cells(I, 2)[/COLOR].SpecialCells(xlCellTypeVisible), [COLOR="red"][B].[/B]Cells(I, 2)[/COLOR]) Is Nothing Then ' si la cellule précitée est visible
          ListeMail = ListeMail & ";" & .Cells(I, 2) ' je l'ajoute à la liste

Et quand le filtre est activé dans la feuille "MesDestinataires", ça fonctionne chez moi: seules les adresses mail dans les cellules vides sont ajoutées à ListeMail.

 

[cibleo]

Re : Problème avec While wend ou avec l'argument passé

Bonsoir à tous,

C'est tout bon Modeste.

Pour ceux qui n'avaient pas suivi :

Avec ce code, je crée un PDF, je l'envoie dans un même Mail à une liste de destinataires sélectionnés dans la feuille "MesDestinataires".

Pour la sélection des destinataires : cocher en colonne C puis filtrer.

With objMessage
        .Subject = "Envoi Planning du jour" ' Sujet du mail
        .From = "[EMAIL="cibleo@wanadoo.fr"]cibleo@wanadoo.fr[/EMAIL]"
        .To = ListeMail
        '.BCC = ListeMail
        ' Corps du mail
        [COLOR=darkred].TextBody = "Bonjour à tous," & _[/COLOR]
.../...

Par contre, j'aimerais personnaliser le message pour chacun des mes destinataires au niveau de TextBody.

J'aimerais remplacer le Bonjour à tous, par un Bonjour suivi du prénom de mon destinataire.

Les prénoms des destinataires se trouvent en colonne A de la feuille "MesDestinataires"

Si j'ai bien compris, il faut que j'imbrique une nouvelle boucle dans le while wend pour individualiser mon Bonjour, sinon j'obtiendrai ceci :

Bonjour Samuel, Philippe, et non pas Bonjour samuel, puis Bonjour Philippe,

Pouvez-vous m'aider à nouveau, car je me demande s'il ne faut pas que je crée autant de message que de destinataires finalement !

Ci-joint le fichier avec les modifications effectuées.

Bonne soirée Cibleo

 

[Modeste]

Re : Problème avec While wend ou avec l'argument passé

Salut cibleo, bonsoir le forum,

Pouvez-vous m'aider à nouveau, car je me demande s'il ne faut pas que je crée autant de message que de destinataires finalement !

... Ben je ne crois pas que tu aies d'autre choix!? Ou alors je n'ai pas bien compris?

Pas trop le temps pour le moment, mais si tu garnis ta variable ListeMail avec les différentes adresses concaténées, il faudra, en parallèle créer une liste des prénoms (sous forme de chaîne à "splitter" ensuite) ou en mettant les adresses et les prénoms dans un tableau et traiter une paire (prénom - adresse) à la fois.

Bon travail,

 

[Modeste]

Re : Problème avec While wend ou avec l'argument passé

re-bonsoir,

Je confirme que je n'ai pas eu plus de temps qu'annoncé ... Mais ça n'empêche pas d'y penser (si, si, il m'arrive même de réfléchir ).
Ne serait-il pas plus simple, de vérifier les "x" présents en colonne C de MesDestinataires, plutôt que de filtrer, puis sélectionner les données "visibles". Gain de temps possible.
Une fois ton pdf enregistré, une boucle lit les "x" et trouve l'adresse avec un Offset(0,-1) et le prénom avec un Offset(0,-2) ce qui te permet d'envoyer un message personnalisé à chacun.
Une autre piste à suivre ... J'imagine que d'autres pourraient surgir d'ici ton prochain passage: il y a plein de gens bizarres qui traînent ici, même la nuit

 

[cibleo]

Re : Problème avec While wend ou avec l'argument passé

Bonsoir à tous,
Bonsoir Modeste,

Tu as raison Modeste, pour parvenir à mes fins, il faut que je revoie la structure de mes procédures.

Précédemment, j'envoyais le même message accompagné de son fichier PDF à une liste de destinataires.

Désormais, il faut que je crée autant de messages que de destinataires.

Je vais supprimer la macro ListeDestinataires et intégrer une boucle for each ...next imbriquée dans un While...wend dans la macro EnvoyerMailEtPDF.

Enfin, je pense qu'il faille procéder de cette manière.

Je continue mes recherches, n'hésitez pas à m'aiguiller.

A+ Cibleo