Envoi e-mail Outlook 2013 depuis un fichier Excel avec macros Fermé

Question

Bonjour, 

Bonjour à tous, 

Je me permets de faire appel à votre aide pour une problématique entre Excel et Outlook.

Je suis en train de mettre en place une base de données, via un fichier Excel avec des macros, qui permettra à ma société de recenser et garder à jour tous les documents juridiques importants.

L'une des fonctionnalités que j'aimerais intégrer est l'envoi d'un e-mail lorsqu'un de ces documents (un contrat par exemple) arrive à échéance.
A titre d'exemple,  3 mois avant la date de fin de contrat, j'aimerais qu'un e-mail soit envoyé à la personne référente lui indiquant que son contrat arrive bientôt à échéance.

Voici la base de données qui a été créé :
https://mon-partage.fr/f/ypPCjHp6/

Mot de passe : OUTLOOK

Identifiant 
Last name : A
First Name : Nic
Password : G19PK1


Concrètement, voici ce que j'aimerais : 

Conditions à respecter pour cette fonctionnalité :
	1. La personne étant sur le fichier appartient au département Purchasing (ce sera vérifié via l'UF identification)
	2. La date rentrée dans le champ "1st notification" de l'UF ADDITION_DOC sera celle du jour ou aura été dépassé.
	3. La date rentrée dans le champ "2nd notification" de l'UF ADDITION_DOC sera celle du jour ou aura été dépassé.
	
	
A l'ouverture du fichier,  et une fois que les 2 conditions ci-dessus seront remplies (soit la 1 et la 2 , ou la 1 et la 3), une notification apparaîtra sur l'onglet "Home" indiquant que X nombre de documents arrivent à échéance, et qu'un rappel par e-mail doit être envoyé aux personnes concernées.

Le texte pour cette notification pourrait être le suivant : 
Titre de l'UF : notification
Texte : "X documents will expire shortly. Please advise the concerned people by clicking on "OK"".
(X étant la somme de documents arrivant à échéance)

Quand la personne cliquera sur le bouton "OK", un e-mail s'ouvrira dans Outlook pour chaque document bientôt expiré.

Le texte de l'e-mail pouvant être le suivant : 

¦
To : "E-mail document owner"
Cc : "E-mail purchasing document owner"
Objet : 1st Notification : "Nom du fournisseur - Description du contrat" will expire by "ending date"
Texte de l'e-mail : 

E-mail generated automatically : please do not answer to this e-mail.***

Dear "document owner", 

As a reminder, please be aware that the "type of legal document" with "supplier name" will expire by "ending date".
Please take the necessary actions, if required.

Should you need further information on this "type of legal document" with "supplier name", please consult the file ABC at the following adress : 

Thanks.
¦

Les informations ci-dessus entre "" se retrouvent dans les différents onglets de mon fichier.

N.B pour le texte ci-dessus : pouvez appliquer la mise en forme tel que mise ci-dessus svp.

Voilà pour les explications, j'espère ne rien avoir oublié…

L'un d'entre vous serait-il comment faire ?

D'avance, un grand merci pour votre aide.
Excellente journée, 

N:B : Pour info, j'utilise Microsoft Office 2013.
Dans la mesure du possible, merci de ne pas modifier les macros existantes, car cela fait des mois qu'on travaille dessus, et ca semble enfin marcher parfaitement.

Configuration: Windows 7 / Chrome 49.0.2623.75

thev · Answer

Bonsoir,

ci-jointe une première proposition.
modifications :
1- ajouts dans code relatif à l'Userform IDENTIFICATION
2- ajout d'un module de classe pour événements personnalisés
3- ajout d'un module envoi mail via Outlook
4- ajout de noms relatifs aux colonnes de  la feuille "Legal docs listing" 


https://www.cjoint.com/c/FHyxDgPlsBd

Niconz · Answer

Bonjour Thev, 

Merci beaucoup pour ta proposition, c'est impressionnant.
D'ailleurs, je ne savais pas qu'on avait pas besoin de passer par Outlook pour que le mail soit envoyé.

J'ai noté quelques petites améliorations à apporter : 

	1. La demande d'envoi d'e-mail se fait même si la personne n'appartient pas au département "Purchasing". Il faudrait que seuls les personnes appartenant à ce département soient en droit d'envoyer cet e-mail.
	2. Les mails ne sont pas envoyés en cc au "Purchasing document supervisor"
	3. Quand une seule et même personne est responsable de plusieurs documents arrivant à échéance prochaine, un seul e-mail est envoyé, tel que ci-dessous. 
	Il faudrait que ce soit un mail par document, et ce même si c'est la même personne à chaque fois.
	4. Le fichier n'enregistre plus automatiquement les documents renseignés via le bouton Addition. Est-ce normal ?
	5. Une fois que les mails de notification ont été envoyés, il ne faut pas que le message de notification ré-apparaisse
	6. Pas d'envoi d'e-mails pour les 2nd notifications
	
D'avance, un grand merci pour ton aide, 
Excellente journée,

Niconz · Answer

Et voici la capture d'écran pour le point 3.
Merci.

thev · Answer

Bonjour,

Pour ce qui concerne  l'envoi d'un mail, la solution Outlook est la plus simple puisqu'incluse dans Office. Il existe d'autres solutions en particulier avec CDO mais qui demande la configuration du serveur de messagerie et une installation supplémentaire.

Les points 1 et 2 sont notés.
Pour le point 3, donc la même personne recevra en même temps plusieurs emails dès lors que les documents sont différents.
Pour le point 4, à vous de regarder car je ne suis pas intervenu dans le code concerné
Pour le point 5, pouvez préciser les noms de la feuille et de la colonne  à renseigner lorsque le mail de notification a été envoyé.
Pour le point 6, je vais vérifier car cela aurait du fonctionner. 


Je vous fais un retour d'ici demain car je serai absent une partie de la journée.

Niconz · Answer

Salut Thev, 

Merci pour ton retour rapide.
Ci-dessous mes réponses à tes questions : 
	3. Oui, la même personne recevra en même temps plusieurs emails dès lors que les documents sont différents. 
	4. OK, je vérifie le code
	5. Feuille "legal docs listing", à partir de la colonne AY
	
	
Enfin, dans le message de l'e-mail, pouvez-vous veiller à garder la mise en forme tel que donnée dans mon 1er post 
" Should you need further information on this "type of legal document" with "supplier name", please consult the file ABC at the following adress" : 

D'avance, merci beaucoup, 
Excellente journée,

thev · Answer

Bonjour,

Réponses notées.

Pour la mise en forme, souligné et gras ne posent pas de problème car les simples balises HTML seront suffisantes.
Pour une mise en forme plus élaborée, un modèle Word serait nécessaire.

thev · Answer

Bonsoir,

ci-joint  2ème proposition

https://www.cjoint.com/c/FHzvrnsBOCm


J'ai au final résolu la non reconduction des notifications en ajoutant un commentaire sur les dates des rappels effectués

Niconz · Answer

Bonjour Thev, 

Merci beaucoup, tout a l'air de marcher parfaitement.
Je continue de faire des tests dans tous les sens, et vous reviens si jamais je constate des bugs.

Excellent weekend,

thev · Answer

Parfait.

ci-dessous nouvelle version avec modif mineure simplifiant le code

 https://www.cjoint.com/c/FHAmxgloQjg

Niconz · Answer

Bonjour Thev, 

Encore merci pour votre input.
J'ai découvert quelques coquilles dans mon fichier, que j'essaye désesperement de corriger.

Pour des raisons que j'ignore, j'ai du prendre les versions antérieurs aux fonctionnalités Outlook, car votre version me faisait des bugs à l'ouverture.

Tout ca pour dire qu'une fois que j'aurai corrigé ces bugs, j'aurai très certainement besoin de vous pour ré-intégrer ces fonctionnalités Outlook dans mon fichier... :), en epsérant que ca vous dérange pas.

Merci beaucoup pour votre aide continue !

Très bonne journée,

thev · Answer

Bonjour,

Pas de souci.  Pour info, ma version correspond à office 2013 64 bits.

Niconz · Answer

Bonjour Thev, 

Pour faire suite à mon post précédent, je pense avoir enfin résolu mes coquilles :), et aurai besoin de votre aide pour réintégrer vos fonctionnalités Outlook…

D'ailleurs, je me suis aperçu qu'il manquait une fonctionnalité Outlook, que je vous détaillerai plus tard.

Toujours ok pour vous ?

Je devrai pouvoir vous envoyer ca d'ici début de semaine au plus tard, voire peut-être même cet après-midi.

Merci beaucoup :)

thev · Answer

OK. c'est noté.

Niconz · Answer

Bonjour Thev, 

Comme promis, ci-joint le fichier dans sa version finale.

https://www.cjoint.com/c/FIqo7x7SoTf 

Pourriez-vous svp y intégrer vos fonctionnalités, a l'identique de nos derniers échanges ? (post numero 9)

Enfin, pourrais-je vous demander d'y ajouter la fonctionnalité suivante : 

Lorsqu'un un nouvel utilisateur crée son compte (UF NEW_IDENTIFICATION), un pop-up s'affiche pour lui donner son mdp.
J'aimerais que ce mot de passe lui soit envoyé par e-mail, et ce même si c'est de sa propre boite mail.
L'important est qu'il est une trace écrite de son mdp pour ce fichier.

Le texte de l'e-mail pouvant être le suivant : 


To : "your e-mail" 
Objet : "Your password for X" 
Texte de l'e-mail :

E-mail generated automatically : please do not answer to this e-mail.***

¦ 
Dear "first name" "last name", 

Thank you for your registration and welcome to the X
Please find below your login details : 

Last name : "Last name"
First name : "First name"
Password : "password" 


Thanks. 
¦ 

Les informations ci-dessus entre "" se retrouvent dans l'onglet "Data base entreprise". 

N.B pour le texte ci-dessus : pouvez-vous svp veiller à appliquer la mise en forme tel que mise ci-dessus. 

N’hésitez pas si jamais j'ai loupé quelque chose.

Un grand merci, très bonne journée,

thev · Answer

Bonsoir,

ci-jointe nouvelle version
 https://www.cjoint.com/c/FItqcgoSJsn

A noter que dans la feuille "Specs", vous avez dans les colonnes de dates de rappel, des valeurs qui ne sont pas reconnues en tant que date : lignes 5 et 6, ligne 18, ....
Je vous conseille d'établir un contrôle de saisie d'une date via la fonction "validation des données".

Niconz · Answer

Bonjour Thev, 

Super, merci beaucoup, ça marche quasiment parfaitement.

J’ai juste noté 1 petit bug qui mériterait correction svp.

Lorsque plusieurs documents arrivent à expiration, et que les e-mails sont envoyés, le champ « document owner » qui est repris est le même dans tous les mails.
J’ai fait le test 2 fois pour 2 documents arrivant à expiration, et à chaque fois, le document owner qui s’affichait était le dernier des 2 docs qui arrivaient à expiration (dans l’ordre chronologique). 

Concernant votre remarque, merci pour le rappel, mais les infos qui figurent dans cet onglet ne sont pour le moment que le résultat de mes tests précédents.
Lorsque je chargerai mon historique, je veillerai bien à ce que cette colonne soit configurée pour reconnaître les champs en date, en espérant que cela n’occasionne pas de bugs avec les macros.


Enfin, point très important, auriez-vous modifié les macros existantes avant votre intervention ? car les fonctionnalités qui se cachent derrière les boutons « Modify, Search & Reporting » ne marchent plus désormais… ce qui m’effraie un peu.

Je n’ai pas de message d’erreur, mais quand je tests ces boutons, il ne me trouve aucun docs correspondant aux champs remplis, alors qu’il y en a bien plusieurs…
Savez-vous à quoi cela est-il dû ?

D’avance, merci pour votre retour, ainsi que pour votre aide, 

Excellente journée,

thev · Answer

Bonjour,

ci-jointe nouvelle version
https://www.cjoint.com/c/FIuliOMVBDv


1- bug « document owner » 
En fait, c'était le champ  « supplier name» qui était affiché dans le mail. Correction effectuée.

2-bug« Modify, Search & Reporting »
Je n'ai touché aucune macro existante mais simplement défini à tort une 2ème fois la variable "mondep" (Department) dans le code « Identification », ce qui impliquait que le contenu de cette variable n'était plus disponible pour les codes « Modify, Search & Reporting ». Correction effectuée.

Niconz · Answer

Re-bonjour Thev, 

Merci pour votre retour et résolution rapide.

Je suis désolé de continuer à vous embeter avec ca, mais j’ai encore un bug avec le bouton reporting.

Selon mes tests (ca ne me le fait pas tout le temps, alors que j’effectue exactement le même test à chaque fois), j’ai le message d’erreur suivant :

Après avoir cliqué sur Debug, voici la ligne qui est jaunie…





Une idée ?

Mille merci pour votre aide en continue.
Très bonne soirée,

thev · Answer

Bonsoir,

A mon avis, il suffit de déprotéger la feuille "Reporting" via le menu révision. Dans le code, je n'ai trouvé trace que de la protection du classeur et de la feuille "Legal docs listing"

Niconz · Answer

Bonjour Thev, 

En effet, ca à l'air de suffire.
Pourquoi faire compliqué quand on peut faire simple.

Encore mille mercis pour votre aide, 

Très bonne journée et continuation,

Niconz · Answer

Bonjour Thev, 
Comment allez-vous ?
Encore moi, et oui... :)
Dîtes-moi, je suis sur le point de déployer mon fichier, et il m'a été indiqué qu'il serait bien de faire un corps de e-mail différent par rappel envoyé. (auj, le même mail est envoyé pour les 2 rappels).
Bref, pourrais-je ré-abuser de votre savoir ?
Si oui, je vous envoie ma dernière version de fichier.
D'avance, merci beaucoup, et très bonne journée,

Niconz · Answer

Re, 
Merci beaucoup, c'est très sympa à vous.
Voici le fichier: https://www.cjoint.com/c/FLmlajrKXWf
Pour les mails, voici les textes et formats à respecter svp : 
Si jamais j ai oublie qq chose, nhesitez pas.
Encore merci.
1er rappel, qui correspond au 1er reminder : 
To : "E-mail document owner" 
Cc : "E-mail purchasing document owner" 
Objet : 1st Reminder : the "type of legal document" with "Nom du fournisseur" will expire by "ending date" 
Texte de l'e-mail :

E-mail generated automatically : please do not answer to this e-mail.***Dear "document owner", 
As a 1st reminder, please note that the "type of legal document" will expire by "ending date". 
Below a quick summary of the main contract information : 
- Starting date : "Starting date"
- Ending date : "Ending date"
- Description : "Description"
- Termination notice : "Termination notice"
- Annual value : "Annual value" "Currency"
- Comments :  "Comments"
Should you need to take any actions regarding this "type of legal document" with "Nom du fournisseur", please do so before its expiration date.
For further information on this document, please consult the Purchasing contractual Database at the following address : ABC
Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary.
Thanks. 
Best regards, 
2eme rappel, qui correspond au 2eme reminder: 
To : "E-mail document owner" 
Cc : "E-mail purchasing document owner" 
Objet : 2nd and last reminder : the "type of legal document" with "Nom du fournisseur" will expire by "ending date" 
Texte de l'e-mail :

E-mail generated automatically : please do not answer to this e-mail.***Dear "document owner", 
As a 2nd and last reminder, please note that the "type of legal document" will expire by "ending date". 
Below a quick summary of the main contract information : 
- Starting date : "Starting date"
- Ending date : "Ending date"
- Description : "Description"
- Termination notice : "Termination notice"
- Annual value : "Annual value" "Currency"
- Comments :  "Comments"
Should you need to take any actions regarding this "type of legal document" with "Nom du fournisseur", please do so before its expiration date.
For further information on this document, please consult the Purchasing contractual Database at the following address : ABC
Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary.
Thanks. 
Best regards,

thev · Answer

Bonsoir,
ci-jointe nouvelle version
https://www.cjoint.com/c/FLmsFs2RIVj

Niconz · Answer

Bonjour Thev, 
Encore un grand merci pour votre aide, ca a l'air de marcher à merveille, après quelques tests sommaires.
Je continue, et vous tiens au courant si je découvre quelques petites coquilles.
Mille mercis, très bonne journée,

Niconz · Answer

Re, 
Rien à re-dire sur la modif, ca marche parfaitement.
Serait-il possible que le mail recu soit flagué "important" dans Outlook, car vu le nombre de mails qu'on recoit tous les jours, j'aimerais si possible que ces mails automatiques sortent un peu du lot.
D'ailleurs, s'il est aussi possible de mettre une échéance à l'e-mail, ce serait encore mieux.
La date serait la ending date du document en question.
Merci d'avance pour votre retour, 
Très cordialement,

thev · Answer

ci-jointe nouvelle avec importance haute et date d'expiration 
https://www.cjoint.com/c/FLnmNHRwDLV

Niconz · Answer

Super, merci beaucoup, j'essaye tout ca !
Très bonne journée,

Niconz · Answer

Bonjour Thev, 
Dernière petite question pratique (enfin je l'espère :)) : entre les 2 dernières versions sur lesquels vous avez fait les modif, pouvez-vous me confirmer que les différences sont bien sur les points là soulignés en gras. 
J'ai constaté que entre l'avant dernière et la dernière, il y avait les différences suivantes dans le module MENVOI_MAIL : 
Sub envoi_mail(ByVal destinataire_A As String, ByVal objet As String, ByVal html_texte As String, ByVal échéance As Date, ByRef erreur, Optional ByVal destinataire_CC As Variant)
    Dim réponse As Integer
    On Error Resume Next    'activation routine d'erreur
    erreur = False
    'Assignation de l'application Outlook et de l'objet email
    Set olk = CreateObject("outlook.application")
    Set Email = olk.CreateItem(olMailItem)
    ' ...... définition sujet,et corps du mail
    corps_mail = html_texte
    '....... remplissage sujet, objet, et adresse
    Email.Subject = objet
    Email.HTMLBody = corps_mail
Email.Importance = olImportanceHigh
    Email.ExpiryTime = échéance
    Email.To = destinataire_A
    If Not IsMissing(destinataire_CC) Then Email.CC = destinataire_CC
    '....... envoie le message
    Email.Send
    If Err.Number <> 0 Then
        erreur = True
        réponse = MsgBox("erreur : " & Err.DESCRIPTION & "  destinataire = " & destinataire & "   Presser OK pour continuer", vbOKCancel)
        If réponse = vbCancel Then Exit Sub
        Err.Clear
    End If
    'Désassignation objets
     Set olk = Nothing
     Set Email = Nothing
End Sub
La raison de ma question est que j'ai fait quelques modif de mise en page sur l'avant dernière version, et que j'aimerais si possible ne pas avoir à tout refaire.
Encore merci et très belle journée, 
Très cordialement,

thev · Answer

Bonjour,
Je vous confirme qu'il s'agit bien des dernières modifications effectuées dans ce module . 
Dans le code associé à l'Userform Identification
        'envoi mail
        Call envoi_mail(destinataire_A, objet, html_texte, ending_date, erreur, destinataire_CC)

Niconz · Answer

En effet, je l'avais pas vu celle-ci :)
Encore mille mercis pour toute l'aide apportée.
Très bonne continuation.

Niconz · Answer

Re Thev, 
Désolé, je pensais vraiment pouvoir vous laisser tranquille, mais j'ai un petit bug sur votre dernière version...
Lors de la création d'un nouveau compte (via UF New identification), si un des champs n'est pas rempli, ou même s'ils sont tous rempli, j'ai le msg d'erreur ci-dessous...

Je ne comprends pas ce qu'il se passe, car je ne vois pas de différence au niveau du code, mise à part celle dont on a parlé ce matin, que j'ai reproduit à l'identique.
Par contre, j'ai activé les code ssuivants dans "This workbook", car j'ai besoin que l'UF identification soit la 1ere chose qu'on voit à l'ouverture du fichier...
Private Sub Workbook_Open()
Worksheets("HOME").Protect "SALOCIN"
ActiveWorkbook.Protect "SALOCIN"
IDENTIFICATION.Show
Voici le fichier utilisé.
http://www.cjoint.com/c/FLonadxBNVH
Merci (une fois de plus :))

thev · Answer

Bonsoir,
J'avais oublié que  le module MENVOI_MAIL était utilisé ailleurs. Je l'ai donc remodifié afin de rendre le paramètre "échéance" optionnel avec ajustement dans le code associé à l'Userform Identification 
        'envoi mail
        Call envoi_mail(destinataire_A, objet, html_texte, erreur, ending_date, destinataire_CC)
ci-jointe version corrigée
https://www.cjoint.com/c/FLovEDc75cD

Niconz · Answer

Bonjour Thev, 
Merci beaucoup pour votre correction, surtout à une heure aussi tardive !
Ca marche nickel, sauf que les e-mails de fin de contrat sont envoyés avec une importance faible.
Pour l'e-mail de rappel de login, pas de soucis que ce soit en faible, mais pour les fins de contrats, je préfererais que ce soit en important.
Je comprends pas trop pourquoi c'est envoyé en faible, car votre code indique bien "Email.Importance = olImportanceHigh"
Autre question qui n'a rien à voir : est-il possible de faire la même chose avec Gmail ?
Merci beaucoup, très bonne journée,

thev · Answer

Je comprends pas trop pourquoi c'est envoyé en faible, car votre code indique bien "Email.Importance = olImportanceHigh" 
C'est effectivement curieux alors que cela fonctionnait avant cette dernière modification
 Autre question qui n'a rien à voir : est-il possible de faire la même chose avec Gmail ? 
C'est effectivement possible sans passer par Outlook mais cela nécessite de définir en clair un compte Gmail (adresse + mot de passe)

Niconz · Answer

Re, 
J'ai essayé plusieurs alternatives, enlever le high, le remplacer par low, le remettre, etc... à chaque fois il me l'envoie en low.
Avez-vous rajouté qq chose dans le code qui pourrait avoir l'effet inverse ?
ou est-il possible de mettre une priorité différente pour le type de mail envoyé (faible pour les login, et élevé pour les rappels de fin de contrats) ?
Si non, je supprimerai le critère d'importance.
Il suffira juste de supprimer la ligne Email.Importance = olImportanceHigh
dans le module Envoi mail, n'est-ce pas ?
Merci.

thev · Answer

Bon, j'ai trouvé d'où vient le problème. La constante olImportanceHigh n'est pas reconnue car la bibliothèque Microsoft Oulook Object n'est pas cochée dans l'éditeur VBA.
Deux solutions :
1- ajouter cette bibliothèque dans l'éditeur VBA. C'est ce que j'ai fait dans le lien ci-joint
https://www.cjoint.com/c/FLpwb353wYF
2- remplacer cette constante par sa valeur, c'est à dire 2.

Niconz · Answer

Bonjour Thev, 
Parfait, merci beaucoup.
Après un 1er test, ca marche nickel.
Encore merci pour tout.
Très bonne continuation,

Niconz · Answer

Bonjour Thev, 
Je me permets une nouvelle question, sans lien avec mon projet précédent.
Je pense déjà à un nouveau projet, et avant de me lancer dedans, j’aimerais savoir si mon idée tient la route : 
Il s’agirait de mettre en place un formulaire en vue de renseigner un nouveau projet, et avant de commencer à travailler sur ce nouveau projet, la personne devra obtenir l’approbation de son manager.
Cette approbation se fera via un mail Outlook envoyé après le remplissage du formulaire avec l’option vote (réponse par Oui ou par Non)
Ainsi, j’aimerais savoir si les fonctionnalités suivantes sont réalisables : 
- Paramétrer l’envoi d’un mail Outlook via VBA avec l’option vote ? très certainement !
- Enregistrement automatique de la réponse du manager dans le fichier : Suite à la réponse du manager (oui / non), Excel réceptionnera et enregistrera la réponse reçue, et ce bien que le fichier soit fermé…
Ex : je remplis le formulaire, l’envoi pour validation à mon manager. Le fichier est ensuite fermé.
Le lendemain, mon manager accepte ma demande en répondant Oui à mon mail.
Est-il possible de créer quelque chose qui fasse que lorsque la réponse du manager ait été envoyée, elle soit automatiquement enregistrée dans le fichier, et ce sans opération de qui que ce soit ? 
Je doute fort car le fichier sera tout simplement fermé, mais sait-on jamais…
Merci beaucoup pour votre réponse, 
Très bonne journée,

thev · Answer

Bonsoir,
Ce n'est peut être pas infaisable mais cela me parait assez compliqué. Je vous propose une procédure plus simple :
1- constituer un formulaire sur un fichier Excel On Line via la fonction Enquête
2- envoyer le  lien dans le mail à votre manager
3- lui demander de cliquer d'abord sur le lien pour mettre à jour le formulaire avec sa réponse et ensuite de vous renvoyer un mail avec confirmation de sa réponse.

Niconz · Answer

Bonjour Thev, 

Je me permets de revenir vers vous par rapport à mon projet sur lequel vous m’avez paramétré les envois de mail automatiques.
Après déploiement, je me rends compte que j’ai omis de faire figurer une information qui a son importante : « tacite Renewal ».

Ainsi, serait-il possible d’adapter votre code pour que dans l’email que reçoit mon collègue, y figure l’information « tacite renewal », en dessous de la ending date ?

J’ai essayé d’adapter votre code moi-même, mais j’avoue ne pas tout comprendre… :(

Si ok pour vous, pouvez-vous svp me dire où et comment (quel UF et quel sub) votre code at-il été complété, afin que je le reproduise dans mon fichier déployé.

D’avance, un grand merci et un excellent weekend,

thev · Answer

Bonjour Niconz, 1- nommer la colonne P de "Legal Docs Listing" = "Tacit_renewal". 2- ci-dessous code adapté Private Sub Term_Evts_TermDocs() Dim nb_lignes As Long, nb_TermDocs As Integer, réponse As Integer, i As Long, c As Integer Dim dates As Range Set documents = CreateObject("scripting.dictionary") 'dictionnaire infos documents avec clé n°document + indice colonne date rappel Dim commentaire As Object Dim id_document As Variant Dim infos_doc(): infos_init = Array("", "", "", "", "", "", "", "", "", "", "", "", "", "") Dim lig_et_col_rappel() As String Dim objet As String, notif As String, destinataire_A As String, destinataire_CC As String Dim document_owner As String, type_document As String, supplier_name1 As String, desc_contrat As String, tacit_renewal As String Dim starting_date As Date, ending_date As Date, TERMINATION_NOTICE As String, annual_value As Single, devise As String, COMMENTS As String Dim notif_envoyée As Boolean, erreur As Boolean, mails_ok As Boolean Const Purchasing As String = "Purchasing" '.............. Dénombrage documents arrivés à échéance et stockage documents avec infos documents nb_TermDocs = 0 For Each dates In Range("reminder_dates_to_send").SpecialCells(xlCellTypeConstants).Rows For c = 1 To 2 If IsDate(dates.Columns(c)) Then Set commentaire = dates.Columns(c).Comment If commentaire Is Nothing Then notif_envoyée = False _ Else notif_envoyée = True 'si la date de rappel est dépassée et que la notification n'a pas été faite If dates.Columns(c) < Date And Not notif_envoyée Then nb_TermDocs = nb_TermDocs + 1 id_document = Range("Document_number").Rows(dates.Row) & "." & c 'n°document + indice colonne date rappel destinataire_A = Range("E_mail_document_owner").Rows(dates.Row) destinataire_CC = Range("E_mail_purchasing_document_supervisor").Rows(dates.Row) document_owner = Range("Document_owner").Rows(dates.Row) type_document = Range("Type_of_legal_document").Rows(dates.Row) supplier_name1 = Range("supplier_name1").Rows(dates.Row) desc_contrat = Range("Description_of_the_document").Rows(dates.Row) starting_date = Range("Starting_date_of_the_document").Rows(dates.Row) ending_date = Range("Ending_date_of_the_document").Rows(dates.Row) tacit_renewal = Range("Tacit_renewal").Rows(dates.Row) TERMINATION_NOTICE = Range("Termination_notice").Rows(dates.Row) annual_value = Range("Document_value__yearly_basis").Rows(dates.Row) devise = Range("Currency_of_the_document").Rows(dates.Row) COMMENTS = Range("Comments").Rows(dates.Row) If Not documents.Exists(id_document) Then infos_doc = infos_init infos_doc(0) = dates.Row & "/" & c ' ligne du document et colonne de la date de rappel infos_doc(1) = destinataire_A ' personne destinataire du mail infos_doc(2) = destinataire_CC ' personne en copie du mail infos_doc(3) = document_owner infos_doc(4) = type_document infos_doc(5) = supplier_name1 infos_doc(6) = desc_contrat infos_doc(7) = starting_date infos_doc(8) = ending_date infos_doc(9) = TERMINATION_NOTICE infos_doc(10) = annual_value infos_doc(11) = devise infos_doc(12) = COMMENTS infos_doc(13) = tacit_renewal documents.Add Key:=id_document, Item:=infos_doc Else MsgBox "numéro document " & document & "en double - ligne " & dates.Row & " non prise en compte" End If End If End If Next Next Stop If mondep = Purchasing Then 'contrôle appartenance de la personne connectée au département Purchasing réponse = MsgBox(nb_TermDocs & " documents will expire shortly. Please advise the concerned people by clicking on OK", vbOKCancel) If réponse = vbCancel Then Exit Sub Else Exit Sub End If '........... Envoi mails aux destinataires mails_ok = True For Each id_document In documents.keys 'récup infos documents infos_doc = documents(id_document) lig_et_col_rappel = Split(infos_doc(0), "/") ' mise en tableau ligne du document et colonne de la date de rappel destinataire_A = infos_doc(1) destinataire_CC = infos_doc(2) document_owner = infos_doc(3) type_document = infos_doc(4) supplier_name1 = infos_doc(5) desc_contrat = infos_doc(6) starting_date = infos_doc(7) ending_date = infos_doc(8) TERMINATION_NOTICE = infos_doc(9) annual_value = infos_doc(10) devise = infos_doc(11) COMMENTS = infos_doc(12) tacit_renewal = infos_doc(13) 'remplissage objet If lig_et_col_rappel(1) = 1 Then notif = "1st" If lig_et_col_rappel(1) = 2 Then notif = "2nd and last" objet = notif & " Reminder: the " & type_document & " with " & supplier_name1 & " will expire by " & ending_date 'remplissage texte html_texte = "Dear " & document_owner & "

" html_texte = html_texte & IIf(notif = "2nd and last", " As a " & notif & "", "As a " & notif) html_texte = html_texte & " reminder, please note that the " & type_document html_texte = html_texte & " with " & supplier_name1 & " will expire by " & ending_date & ".

" html_texte = html_texte & "Below a quick summary of the main contract information :
" html_texte = html_texte & "- Starting date : " & starting_date & ".
" html_texte = html_texte & "- Ending date : " & ending_date & ".
" html_texte = html_texte & "- Tacite renewal : " & tacit_renewal & ".
" html_texte = html_texte & "- Description : " & desc_contrat & ".
" html_texte = html_texte & " - Termination notice : " & TERMINATION_NOTICE & ".
" html_texte = html_texte & "- Annual value : " & annual_value & " " & devise & ".
" html_texte = html_texte & "- Comments : " & COMMENTS & ".

" html_texte = html_texte & "Should you need to take any actions regarding this " & type_document & "" html_texte = html_texte & " with " & supplier_name1 & ", please do so before its expiration date.

" html_texte = html_texte & "For further information on this document, please consult the Purchasing contractual Database at the following address : ABC

" html_texte = html_texte & "Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary.

" html_texte = html_texte & "Thanks..

" & "Best regards.

" html_texte = html_texte & "

*** E-mail generated automatically : please do not answer to this e-mail.***" 'envoi mail Call envoi_mail(destinataire_A, objet, html_texte, erreur, ending_date, destinataire_CC) If Not erreur Then 'mise à jour rappel envoyé dans la feuille "legal docs listing" i = lig_et_col_rappel(0) c = lig_et_col_rappel(1) Range("reminder_dates_to_send").Cells(i, c).AddComment "mail sent to " & Date Else mails_ok = False End If Next id_document '..... message fin traitement If mails_ok Then MsgBox "Thank you. The e-mails have been sent to the recipients"End Sub --

Niconz · Answer

Bonjour Thev, 

Merci beaucoup de votre retour rapide.
Instructions suivi à la lettre, mais j'ai une "compile error : wrong number of arguments or invalid assignment" lors de mon test de bon fonctionnement.

Le code jaunie est "Call envoi mail"...

Une idée ?
Merci de votre aide.

thev · Answer

Bonjour,

S'il y a un souci au niveau du "Call envoi mail"... , c'est que le module MEnvoi_Mail n'est pas à jour :
Sub envoi_mail(ByVal destinataire_A As String, ByVal objet As String, ByVal html_texte As String, ByRef erreur, Optional ByVal échéance As Variant, Optional ByVal destinataire_CC As Variant)        Dim réponse As Integer        On Error Resume Next    'activation routine d'erreur    erreur = False        'Assignation de l'application Outlook et de l'objet email    Set olk = CreateObject("outlook.application")    Set Email = olk.CreateItem(olMailItem)        ' ...... définition sujet,et corps du mail    corps_mail = html_texte        '....... remplissage sujet, objet, et adresse    Email.Subject = objet    Email.HTMLBody = corps_mail    Email.Importance = olImportanceHigh    Email.To = destinataire_A    If Not IsMissing(échéance) Then Email.ExpiryTime = échéance    If Not IsMissing(destinataire_CC) Then Email.CC = destinataire_CC       '....... envoie le message    Email.Send    If Err.Number <> 0 Then        erreur = True        réponse = MsgBox("erreur : " & Err.DESCRIPTION & "  destinataire = " & destinataire & "   Presser OK pour continuer", vbOKCancel)        If réponse = vbCancel Then Exit Sub        Err.Clear    End If         'Désassignation objets     Set olk = Nothing     Set Email = Nothing        End Sub

Niconz · Answer

Bonjour, 

Merci, ca marche !
Par contre, j'ai toujours le problème de l'e-mail envoyé en importance faible, alors que ca devrait être le contraire.


Votre réponse à l'époque : 

Bon, j'ai trouvé d'où vient le problème. La constante olImportanceHigh n'est pas reconnue car la bibliothèque Microsoft Oulook Object n'est pas cochée dans l'éditeur VBA. 
Deux solutions : 
1- ajouter cette bibliothèque dans l'éditeur VBA. C'est ce que j'ai fait dans le lien ci-joint 
https://www.cjoint.com/c/FLpwb353wYF 

2- remplacer cette constante par sa valeur, c'est à dire 2.

Comment faire dans mon cas précis ?

Merci encore :)

thev · Answer

Bonjour,

Dans le fichier que vous m'avez renvoyé, la bibliothèque Microsoft Outlook Object est bien ajoutée (cochée).
Editeur VBA --> Outils --> Références

Niconz · Answer

Bonjour Thev, 

Parfait !

Encore un grand merci :)

Très belle journée,

Niconz · Answer

Bonjour Thev, Je reviens vers vous car j'aimerais compléter l'e-mail envoyé automatiquement, avec un champ supplémentaire > Tacit Renewal. J'ai essayé de me dépatouiller tout seul, en adaptant le code comme ci-après : En gras mon complément de code. [UF identification] ' *********** ajout thev du 19/09/2016 ************************************************************************************* Dim WithEvents Term_Evts As CustomEvents 'événement échéance documents du module de classe CustomEvents Private Sub Frame3_Click() End Sub Private Sub UserForm_Initialize() ' Set Term_Evts = New CustomEvents 'activation événement échéance documents End Sub Private Sub Term_Evts_TermDocs() Dim nb_lignes As Long, nb_TermDocs As Integer, réponse As Integer, i As Long, c As Integer Dim dates As Range Set documents = CreateObject("scripting.dictionary") 'dictionnaire infos documents avec clé n°document + indice colonne date rappel Dim commentaire As Object Dim id_document As Variant Dim infos_doc(): infos_init = Array("", "", "", "", "", "", "", "", "", "", "", "", "", "") Dim lig_et_col_rappel() As String Dim objet As String, notif As String, destinataire_A As String, destinataire_CC As String Dim document_owner As String, type_document As String, supplier_name1 As String, desc_contrat As String, tacit_renewal As String Dim starting_date As Date, ending_date As Date, TERMINATION_NOTICE As String, annual_value As Single, devise As String, COMMENTS As String Dim notif_envoyée As Boolean, erreur As Boolean, mails_ok As Boolean Const Purchasing As String = "Purchasing" '.............. Dénombrage documents arrivés à échéance et stockage documents avec infos documents nb_TermDocs = 0 For Each dates In Range("reminder_dates_to_send").SpecialCells(xlCellTypeConstants).Rows For c = 1 To 2 If IsDate(dates.Columns(c)) Then Set commentaire = dates.Columns(c).Comment If commentaire Is Nothing Then notif_envoyée = False _ Else notif_envoyée = True 'si la date de rappel est dépassée et que la notification n'a pas été faite If dates.Columns(c) < Date And Not notif_envoyée Then nb_TermDocs = nb_TermDocs + 1 id_document = Range("Document_number").Rows(dates.Row) & "." & c 'n°document + indice colonne date rappel destinataire_A = Range("E_mail_document_owner").Rows(dates.Row) destinataire_CC = Range("E_mail_purchasing_document_supervisor").Rows(dates.Row) document_owner = Range("Document_owner").Rows(dates.Row) type_document = Range("Type_of_legal_document").Rows(dates.Row) supplier_name1 = Range("supplier_name1").Rows(dates.Row) desc_contrat = Range("Description_of_the_document").Rows(dates.Row) starting_date = Range("Starting_date_of_the_document").Rows(dates.Row) ending_date = Range("Ending_date_of_the_document").Rows(dates.Row) tacit_renewal = Range("Tacit_renewal").Rows(dates.Row) TERMINATION_NOTICE = Range("Termination_notice").Rows(dates.Row) annual_value = Range("Document_value__yearly_basis").Rows(dates.Row) devise = Range("Currency_of_the_document").Rows(dates.Row) COMMENTS = Range("Comments").Rows(dates.Row) If Not documents.Exists(id_document) Then infos_doc = infos_init infos_doc(0) = dates.Row & "/" & c ' ligne du document et colonne de la date de rappel infos_doc(1) = destinataire_A ' personne destinataire du mail infos_doc(2) = destinataire_CC ' personne en copie du mail infos_doc(3) = document_owner infos_doc(4) = type_document infos_doc(5) = supplier_name1 infos_doc(6) = desc_contrat infos_doc(7) = starting_date infos_doc(8) = ending_date infos_doc(9) = TERMINATION_NOTICE infos_doc(10) = annual_value infos_doc(11) = devise infos_doc(12) = COMMENTS infos_doc(13) = tacit_renewal documents.Add Key:=id_document, Item:=infos_doc Else MsgBox "numéro document " & document & "en double - ligne " & dates.Row & " non prise en compte" End If End If End If Next Next Stop If mondep = Purchasing Then 'contrôle appartenance de la personne connectée au département Purchasing réponse = MsgBox(nb_TermDocs & " documents will expire shortly. Please advise the concerned people by clicking on OK", vbOKCancel) If réponse = vbCancel Then Exit Sub Else Exit Sub End If '........... Envoi mails aux destinataires mails_ok = True For Each id_document In documents.keys 'récup infos documents infos_doc = documents(id_document) lig_et_col_rappel = Split(infos_doc(0), "/") ' mise en tableau ligne du document et colonne de la date de rappel destinataire_A = infos_doc(1) destinataire_CC = infos_doc(2) document_owner = infos_doc(3) type_document = infos_doc(4) supplier_name1 = infos_doc(5) desc_contrat = infos_doc(6) starting_date = infos_doc(7) ending_date = infos_doc(8) TERMINATION_NOTICE = infos_doc(9) annual_value = infos_doc(10) devise = infos_doc(11) COMMENTS = infos_doc(12) tacit_renewal = infos_doc(13) 'remplissage objet If lig_et_col_rappel(1) = 1 Then notif = "1st" If lig_et_col_rappel(1) = 2 Then notif = "2nd and last" objet = notif & " Reminder: the " & type_document & " with " & supplier_name1 & " will expire by " & ending_date 'remplissage texte html_texte = "Dear " & document_owner & "

" html_texte = html_texte & IIf(notif = "2nd and last", " As a " & notif & "", "As a " & notif) html_texte = html_texte & " reminder, please note that the " & type_document html_texte = html_texte & " with " & supplier_name1 & " will expire by " & ending_date & ".

" html_texte = html_texte & "Below a quick summary of the main contract information :
" html_texte = html_texte & "- Starting date : " & starting_date & ".
" html_texte = html_texte & "- Ending date : " & ending_date & ".
" html_texte = html_texte & "- Tacite renewal : " & tacit_renewal & ".
" html_texte = html_texte & "- Description : " & desc_contrat & ".
" html_texte = html_texte & " - Termination notice : " & TERMINATION_NOTICE & ".
" html_texte = html_texte & "- Annual value : " & annual_value & " " & devise & ".
" html_texte = html_texte & "- Comments : " & COMMENTS & ".

" html_texte = html_texte & "Should you need to take any actions regarding this " & type_document & "" html_texte = html_texte & " with " & supplier_name1 & ", please do so before its expiration date.

" html_texte = html_texte & "For further information on this document, please consult the Purchasing contractual Database at the following address : file://BSAFIL01/INFGES/PCDtools/PCD.xlsm

" html_texte = html_texte & "Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary.

" html_texte = html_texte & "Thanks..

" & "Best regards.

" html_texte = html_texte & "

*** E-mail generated automatically : please do not answer to this e-mail.***" 'envoi mail Call envoi_mail(destinataire_A, objet, html_texte, erreur, ending_date, destinataire_CC) If Not erreur Then 'mise à jour rappel envoyé dans la feuille "legal docs listing" i = lig_et_col_rappel(0) c = lig_et_col_rappel(1) Range("reminder_dates_to_send").Cells(i, c).AddComment "mail sent to " & Date Else mails_ok = False End If Next id_document '..... message fin traitement If mails_ok Then MsgBox "Thank you. The e-mails have been sent to the recipients" End Sub ' *********** fin ajout thev du 25/08/2016 ********************************************************************************************* Private Sub CANCEL_Click() Application.DisplayAlerts = False Application.QUIT End Sub Private Sub CommandButton1_Click() Me.Hide NEW_IDENTIFICATION.Show End Sub Private Sub CONTINUE_Click() With Sheets("Sheet1") 'premiere ligne vide Ligne = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1 .Range("A" & Ligne) = Date ' INSCRIPTION DES DONNEES DANS L'ONGLET Sheet1 .Range("B" & Ligne) = Me.LAST_NAME .Range("C" & Ligne) = Me.FIRST_NAME End With If LAST_NAME = "" Or FIRST_NAME = "" Or PASSWORD = "" Then MsgBox "Please complete missing data": Exit Sub ActiveWorkbook.Unprotect "SALOCIN" With Sheets("Data base Entreprise") Ligne = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row 'verification que nom, prenom et mdp sont corrects (existent dans Data base) si c'est le cas bon passe à 1 et on relève le dptmnt dans variable mondep For n = 3 To Ligne If .Range("A" & n) = FIRST_NAME And .Range("B" & n) = LAST_NAME And .Range("H" & n) = PASSWORD Then bon = 1: mondep = .Range("E" & n) Next End With If bon = 0 Then MsgBox "Sorry, your login details do not match our record. Please try again": Exit Sub Sheets("HOME").Visible = True Sheets("Identification").Visible = False ActiveWorkbook.Protect "SALOCIN" Me.Hide ' *********** ajout thev du 19/09/2016 ******************************* Term_Evts.Check 'vérification échéance documents légaux ' *********** fin ajout thev du 19/09/2016 *************************** End Sub Private Sub FIRST_NAME_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) 'majuscule à l'initiale FIRST_NAME = Application.WorksheetFunction.Proper(FIRST_NAME) End Sub Private Sub FIRST_NAME_Change() 'Effacement de FIRST NAME If Left(FIRST_NAME, 4) = "FIRS" Then FIRST_NAME = Right(FIRST_NAME, 1) End Sub Private Sub LAST_NAME_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) 'nom en majuscules LAST_NAME = UCase(LAST_NAME) End Sub Private Sub LAST_NAME_Change() 'Effacement de LAST NAME If Left(LAST_NAME, 4) = "LAST" Then LAST_NAME = Right(LAST_NAME, 1) End Sub Private Sub PASSWORD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 'Effacement de PASSWORD If PASSWORD.VALUE = "PASSWORD" Then PASSWORD = "": PASSWORD.PasswordChar = "*" End Sub Private Sub UserForm_Terminate() Application.DisplayAlerts = False Application.QUIT End Sub mais j'ai l'erreur suivante "Run time error 1004, method 'Range of object'_Global failed", avec comme ligne jaunie "tacit_renewal = Range("tacit_renewal").Rows(dates.Row). Et lorsque VBA s'ouvre après le run time error, j'ai un autre message indiquant qu'il ne peut pas exécuter le code en break mode… J'ai vérifié la cellule à laquelle renvoit l'erreur, et celle-ci comprend bien un "Yes", comme le veut mon fichier. Pouvez-vous me dire ce qui ne va pas, voire me renvoyer le code corrigé en indiquant en gras les changements que vous avez effectués ? D'avance, merci beaucoup. Excellente soirée,

thev · Answer

Je n'ai conservé qu'une version d'essai de votre application et n'ai même pas la dernière version du code.

Niconz · Answer

Est-ce que le code de l’UF vous suffit, ou avez-vous besoin de l’application toute entière ?

Maintenant qu’elle est déployée, difficile pour moi de l’envoyer sur le forum car les données sont confidentielles.
Si vraiment nécessaire, je ferai une version vierge, mais ça prendra un peu de temps, et j’aurai besoin que vous m’indiquiez clairement là où il y a eu des changements afin que je les réplique dans mon fichier « live ».

Merci.

Niconz · Answer

Bonjour Thev, 

Pardon, il s'agit en fait d'une nouvelle demande :)

J'aimerais être mis en cci pour toute nouvel accès à l'application. 
Pouvez-vous me compléter le code de l'UF New Identification svp ?

Merci.

thev · Answer

Bonjour,

Et où sera stockée votre adresse Email ?

Niconz · Answer

dans l'UF New Identification...

N'est-il pas possible de mettre une ligne de code comme celle-là, dans le remplissage de l'e-mail du Private Sub Continue_Click >

Destinataire_cci = abc@travail.com

Merci.

Niconz · Answer

Bonjour Thev, Merci pour votre retour et aide. Non, ca ne marche pas, mais à la vue de votre proposition, j'ai pris l'initiative de modidier le code d'origine comme suit (modif en gras), et ca marche, mais mon message envoyé dans Outlook apparaît comme barré et indique que l'e-mail expire le 30 Décembre 1899... UF New identification : Private Sub CANCEL_Click() Me.Hide IDENTIFICATION.Show End Sub Private Sub CONTINUE_Click() For Each ctrl In Me.Controls If (TypeOf ctrl Is MSForms.TextBox Or TypeOf ctrl Is MSForms.ComboBox) Then ctrl.BackColor = vbWhite If ctrl.VALUE = "" Then incomplet = 1 ctrl.BackColor = &HC0C0C0 End If End If Next ctrl If incomplet = 1 Then MsgBox "Please complete the highlighted fields": Exit Sub ActiveWorkbook.Unprotect "SALOCIN" With Sheets("Data base Entreprise") .Unprotect "SALOCIN" Ligne = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1 .Range("A" & Ligne) = Me.FIRST_NAME .Range("B" & Ligne) = Me.LAST_NAME .Range("C" & Ligne) = Me.CPY_SITE .Range("D" & Ligne) = Me.BU .Range("E" & Ligne) = Me.DPTMT .Range("F" & Ligne) = Me.EMAIL_MANAGER .Range("G" & Ligne) = Me.E_MAIL .Range("H" & Ligne).FormulaR1C1 = "=VLOOKUP(RC[-3],C[2]:C[3],2,0)" .Protect "SALOCIN" End With ActiveWorkbook.Protect "SALOCIN" Me.Hide MsgBox "Here is your password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & Chr(10) & "You will receive a confirmation by e-mail shortly" '..... remplissage mail destinataire_A = Me.E_MAIL destinataire_CCI = "abc@travail.com" objet = "Your login details for the Purchasing Contractual Database" html_texte = "Dear " & Me.FIRST_NAME & " " & Me.LAST_NAME & ",

" html_texte = html_texte & "Thank you for your registration and welcome to the Purchasing Contractual Database
" html_texte = html_texte & " Please find below your login details :

" html_texte = html_texte & "Last name : " & Me.LAST_NAME & "
First name : " & Me.FIRST_NAME & "
" html_texte = html_texte & "Password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & "
" html_texte = html_texte & "

*** E-mail generated automatically : please do not answer to this e-mail.***" '..... envoi mail mail_ok = False Call envoi_mail(destinataire_A, objet, html_texte, erreur, ending_date, destinataire_CC, destinataire_CCI) If Not erreur Then mail_ok = True If mail_ok Then MsgBox "Thank you !" & Chr(10) & "The e-mail confirmation has been sent" '..... retour identification IDENTIFICATION.Show End Sub Private Sub E_MAIL_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) On Error GoTo erreur a = Application.WorksheetFunction.SEARCH("@", E_MAIL.VALUE) Exit Sub erreur: E_MAIL = "" MsgBox "Please try again, the e-mail does not seem correct. @ is missing" End Sub Private Sub EMAIL_MANAGER_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) On Error GoTo erreur a = Application.WorksheetFunction.SEARCH("@", EMAIL_MANAGER.VALUE) Exit Sub erreur: EMAIL_MANAGER = "" MsgBox "Please try again, the e-mail does not seem correct. @ is missing" End Sub Private Sub FIRST_NAME_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) FIRST_NAME = Application.WorksheetFunction.Proper(FIRST_NAME) End Sub Private Sub LAST_NAME_BeforeUpdate(ByVal CANCEL As MSForms.ReturnBoolean) LAST_NAME = UCase(LAST_NAME) End Sub Private Sub UserForm_Activate() For Each ctrl In Me.Controls If (TypeOf ctrl Is MSForms.TextBox Or TypeOf ctrl Is MSForms.ComboBox) Then ctrl.BackColor = vbWhite ctrl.VALUE = "" End If Next End Sub Module d'envoi mail : Sub envoi_mail(ByVal destinataire_A As String, ByVal objet As String, ByVal html_texte As String, ByRef erreur, Optional ByVal échéance As Variant, Optional ByVal destinataire_CC As Variant, Optional ByVal destinataire_CCI As Variant) Dim réponse As Integer On Error Resume Next 'activation routine d'erreur erreur = False 'Assignation de l'application Outlook et de l'objet email Set olk = CreateObject("outlook.application") Set Email = olk.CreateItem(olMailItem) ' ...... définition sujet,et corps du mail corps_mail = html_texte '....... remplissage sujet, objet, et adresse Email.Subject = objet Email.HTMLBody = corps_mail Email.Importance = olImportanceHigh Email.To = destinataire_A If Not IsMissing(échéance) Then Email.ExpiryTime = échéance If Not IsMissing(destinataire_CC) Then Email.CC = destinataire_CC If Not IsMissing(destinataire_CCI) Then Email.BCC = destinataire_CCI '....... envoie le message Email.Send If Err.Number <> 0 Then erreur = True réponse = MsgBox("erreur : " & Err.DESCRIPTION & " destinataire = " & destinataire & " Presser OK pour continuer", vbOKCancel) If réponse = vbCancel Then Exit Sub Err.Clear End If 'Désassignation objets Set olk = Nothing Set Email = Nothing End Sub Une idée de comment corriger ce petit bug Merci !

thev · Answer

Cela devrait fonctionner car ces instructions effaceront
destinataire_A = Me.E_MAIL destinataire_CC = Me.EMAIL_MANAGER celles situées en amont destinataire_A = infos_doc(1) destinataire_CC = infos_doc(2)  --

Niconz · Answer

Ok, merci.

Et encore merci pour tout.
Bonne journée,

Re, 

J'ai peur d'avoir parlé trop vite...

J'ai intégré les modifs précédente (rajout champ tacit renewal dans l'e-mail de rappel + rajout de mon adresse e-mail dans e-mail pour nouvel accès), à l'exception du mail au manager.

Bref, après un test sur un document arrivant à échéance, le mail de rappel est bien envoyé avec les infos comme il faut, mais j'ai le message suivant : 


Je suppose que c'est en lien avec votre post précédent.

Rien de très grave, mais savez-vous comment on peut régler ce petit bug ?

Merci.

thev · Answer

Essayer avec cette nouvelle version du module  envoi_mail

Sub envoi_mail(ByVal destinataire_A As String, ByVal objet As String, ByVal html_texte As String, ByRef erreur, Optional ByVal échéance As Variant, Optional ByVal destinataire_CC As Variant, Optional ByVal destinataire_CCI As Variant)        Dim réponse As Integer        On Error Resume Next    'activation routine d'erreur    Err.Clear               'initialisation erreur    erreur = False        'Assignation de l'application Outlook et de l'objet email    Set olk = CreateObject("outlook.application")    Set Email = olk.CreateItem(olMailItem)        ' ...... définition sujet,et corps du mail    corps_mail = html_texte        '....... remplissage sujet, objet, et adresse    Email.Subject = objet    Email.HTMLBody = corps_mail    Email.Importance = olImportanceHigh    Email.To = destinataire_A    If Not IsMissing(échéance) And Not IsEmpty(échéance) Then Email.ExpiryTime = échéance    If Not IsMissing(destinataire_CC) And Not IsEmpty(destinataire_CC) Then Email.CC = destinataire_CC    If Not IsMissing(destinataire_CCI) And Not IsEmpty(destinataire_CCI) Then Email.BCC = destinataire_CCI       '....... envoie le message    Email.Send    If Err.Number <> 0 Then        erreur = True        réponse = MsgBox("erreur : " & Err.Description & "  destinataire = " & destinataire_A & "   Presser OK pour continuer", vbOKCancel)        If réponse = vbCancel Then Exit Sub        Err.Clear    End If         'Désassignation objets     Set olk = Nothing     Set Email = Nothing        End Sub

Niconz · Answer

Bonjour Thev, 

J'ai désormais le message d'erreur suivant : 

erreur : the object does not support this method. destinataire = mon adresse email

Merci.

thev · Answer

Donc il détecte une erreur sur la méthode .Send du module Envoi_mail. Le remplissage d'un des paramètres optionnels doit provoquer l'erreur. A vous de déterminer lequel en les remplissant un par un.

Niconz · Answer

Ok, donc si je comprends bien, l'erreur vient du fait qu'une cellule ne contient pas d'adresse e-mails dans les colonnes E-mail business owner (AA) ou purchasing owner (AB) de mon onglet legal docs listing.

Est-ce bien ca ?
SI oui, je comprends pas car j'ai corrigé en mettant pour chaque doc (ligne) une adresse e-mail, et bien que les 2 colonnes ci-dessus contiennent bien une adresse e-mail, j'ai le même message d'erreur.

thev · Answer

On va procéder différemment. Vous mettez en commentaire dans le module Envoi_mail les lignes suivantes :
'....... remplissage sujet, objet, et adresse    Email.Subject = objet    'Email.HTMLBody = corps_mail    'Email.Importance = olImportanceHigh    Email.To = destinataire_A    'If Not IsMissing(échéance) And Not IsEmpty(échéance) Then Email.ExpiryTime = échéance    'If Not IsMissing(destinataire_CC) And Not IsEmpty(destinataire_CC) Then Email.CC = destinataire_CC    'If Not IsMissing(destinataire_CCI) And Not IsEmpty(destinataire_CCI) Then Email.BCC = destinataire_CCI 

Vous ne devriez pas avoir de message d'erreur. Après vous réactivez chaque ligne l'une après l'autre pour déceler celle qui génère le message d'erreur.

Niconz · Answer

Bonjour Thev, 

Voici la ligne qui genere le message d'erreur :

If Not IsMissing(échéance) And Not IsEmpty(échéance) Then Email.ExpiryTime = échéance

Et maintenant ?
Merci.

Niconz · Answer

Bonjour Thev, 

Alors la ligne qui bug est la suivante : 
If Not IsMissing(échéance) And Not IsEmpty(échéance) Then  Email.ExpiryTime = échéance

Et maintenant ?
Merci.

thev · Answer

Si cette ligne bugge, cela veut a priori dire que le contenu de échéance n'est pas une date. Il faut donc ajouter un test supplémentaire
If Not IsMissing(échéance) And Not IsEmpty(échéance) And IsDate(échéance) Then Email.ExpiryTime = échéance

Envoi e-mail Outlook 2013 depuis un fichier Excel avec macros

63 réponses

Discussions similaires

Newsletters