Envoi e-mail Outlook 2013 depuis un fichier Excel avec macros
Fermé
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
-
24 août 2016 à 16:16
Niconz Messages postés 310 Date d'inscription lundi 16 juin 2014 Statut Membre Dernière intervention 6 juillet 2020 - 11 sept. 2017 à 15:13
Niconz Messages postés 310 Date d'inscription lundi 16 juin 2014 Statut Membre Dernière intervention 6 juillet 2020 - 11 sept. 2017 à 15:13
A voir également:
- Envoi e-mail Outlook 2013 depuis un fichier Excel avec macros
- Fichier rar - Guide
- Liste déroulante excel - Guide
- Fichier host - Guide
- Comment réduire la taille d'un fichier - Guide
- Comment ouvrir un fichier epub ? - Guide
63 réponses
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
7 avril 2017 à 17:57
7 avril 2017 à 17:57
Bonjour Niconz,
1- nommer la colonne P de "Legal Docs Listing" = "Tacit_renewal".
2- ci-dessous code adapté
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 & "<br><br>"
html_texte = html_texte & IIf(notif = "2nd and last", "<b> As a " & notif & "</b>", "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 & ".<br><br>"
html_texte = html_texte & "Below a quick summary of the main contract information : <br>"
html_texte = html_texte & "- Starting date : " & starting_date & ".<br>"
html_texte = html_texte & "- Ending date : " & ending_date & ".<br>"
html_texte = html_texte & "- Tacite renewal : " & tacit_renewal & ".<br>"
html_texte = html_texte & "- Description : " & desc_contrat & ".<br>"
html_texte = html_texte & " - Termination notice : " & TERMINATION_NOTICE & ".<br>"
html_texte = html_texte & "- Annual value : " & annual_value & " " & devise & ".<br>"
html_texte = html_texte & "- Comments : " & COMMENTS & ".<br><br>"
html_texte = html_texte & "Should you need to take any actions regarding this <u>" & type_document & "</u>"
html_texte = html_texte & " with <b>" & supplier_name1 & "</b>, please do so before its expiration date.<br><br>"
html_texte = html_texte & "For further information on this document, please consult the Purchasing contractual Database at the following address : ABC <br><br>"
html_texte = html_texte & "Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary. <br><br>"
html_texte = html_texte & "Thanks..<br><br>" & "Best regards.<br><br>"
html_texte = html_texte & "<br><br>*** 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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
10 avril 2017 à 12:53
10 avril 2017 à 12:53
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.
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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
10 avril 2017 à 16:42
10 avril 2017 à 16:42
Bonjour,
S'il y a un souci au niveau du "Call envoi mail"... , c'est que le module MEnvoi_Mail n'est pas à jour :
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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
10 avril 2017 à 16:55
10 avril 2017 à 16:55
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 :)
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 :)
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
10 avril 2017 à 17:05
10 avril 2017 à 17:05
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
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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
11 avril 2017 à 07:25
11 avril 2017 à 07:25
Bonjour Thev,
Parfait !
Encore un grand merci :)
Très belle journée,
Parfait !
Encore un grand merci :)
Très belle journée,
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
10 août 2017 à 16:17
10 août 2017 à 16:17
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 & "<br><br>"
html_texte = html_texte & IIf(notif = "2nd and last", "<b> As a " & notif & "</b>", "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 & ".<br><br>"
html_texte = html_texte & "Below a quick summary of the main contract information : <br>"
html_texte = html_texte & "- Starting date : " & starting_date & ".<br>"
html_texte = html_texte & "- Ending date : " & ending_date & ".<br>"
html_texte = html_texte & "- Tacite renewal : " & tacit_renewal & ".<br>"
html_texte = html_texte & "- Description : " & desc_contrat & ".<br>"
html_texte = html_texte & " - Termination notice : " & TERMINATION_NOTICE & ".<br>"
html_texte = html_texte & "- Annual value : " & annual_value & " " & devise & ".<br>"
html_texte = html_texte & "- Comments : " & COMMENTS & ".<br><br>"
html_texte = html_texte & "Should you need to take any actions regarding this <u>" & type_document & "</u>"
html_texte = html_texte & " with <b>" & supplier_name1 & "</b>, please do so before its expiration date.<br><br>"
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 <br><br>"
html_texte = html_texte & "Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary. <br><br>"
html_texte = html_texte & "Thanks..<br><br>" & "Best regards.<br><br>"
html_texte = html_texte & "<br><br>*** 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,
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 & "<br><br>"
html_texte = html_texte & IIf(notif = "2nd and last", "<b> As a " & notif & "</b>", "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 & ".<br><br>"
html_texte = html_texte & "Below a quick summary of the main contract information : <br>"
html_texte = html_texte & "- Starting date : " & starting_date & ".<br>"
html_texte = html_texte & "- Ending date : " & ending_date & ".<br>"
html_texte = html_texte & "- Tacite renewal : " & tacit_renewal & ".<br>"
html_texte = html_texte & "- Description : " & desc_contrat & ".<br>"
html_texte = html_texte & " - Termination notice : " & TERMINATION_NOTICE & ".<br>"
html_texte = html_texte & "- Annual value : " & annual_value & " " & devise & ".<br>"
html_texte = html_texte & "- Comments : " & COMMENTS & ".<br><br>"
html_texte = html_texte & "Should you need to take any actions regarding this <u>" & type_document & "</u>"
html_texte = html_texte & " with <b>" & supplier_name1 & "</b>, please do so before its expiration date.<br><br>"
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 <br><br>"
html_texte = html_texte & "Your purchasing representative (in cc of this e-mail) is of course at your disposal if necessary. <br><br>"
html_texte = html_texte & "Thanks..<br><br>" & "Best regards.<br><br>"
html_texte = html_texte & "<br><br>*** 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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
10 août 2017 à 17:41
10 août 2017 à 17:41
Bonjour,
"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)".
Avez-vous défini le nom de plage "tacit_renewal" avec Formules --> Gestionnaire de noms ?
"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)".
Avez-vous défini le nom de plage "tacit_renewal" avec Formules --> Gestionnaire de noms ?
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
>
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
11 août 2017 à 07:34
11 août 2017 à 07:34
Bonjour,
Oui, j'ai bien une plage du nom de TACIT_RENEWAL qui renvoit à mes 2 valeurs Yes ; No dans mon onglet admin...
Oui, j'ai bien une plage du nom de TACIT_RENEWAL qui renvoit à mes 2 valeurs Yes ; No dans mon onglet admin...
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
>
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
11 août 2017 à 12:00
11 août 2017 à 12:00
Ce nom de plage n'est pas correct. Il devrait renvoyer à la colonne O de "Legal docs listing".
Essayer de créer un nouveau nom de plage (ex : Tacit_renewal_ldl) renvoyant à cette colonne et de changer l'instruction en conséquence:
Essayer de créer un nouveau nom de plage (ex : Tacit_renewal_ldl) renvoyant à cette colonne et de changer l'instruction en conséquence:
tacit_renewal = Range("Tacit_renewal_ldl").Rows(dates.Row)
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
>
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
11 août 2017 à 13:34
11 août 2017 à 13:34
Ok, j'ai compris la logique désormais.
J'ai adapté le code en conséquence, et ca marche parfaitement.
merci beaucoup.
Pendant que j'y suis, 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 ?
Encore merci.
J'ai adapté le code en conséquence, et ca marche parfaitement.
merci beaucoup.
Pendant que j'y suis, 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 ?
Encore merci.
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
11 août 2017 à 15:41
11 août 2017 à 15:41
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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
11 août 2017 à 15:47
11 août 2017 à 15:47
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.
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.
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
11 août 2017 à 16:53
11 août 2017 à 16:53
Pouvez-vous me compléter le code de l'UF New Identification svp ?
Que dois-je compléter puisque vous avez-vous même ajouté les instructions nécessaires pour le champ supplémentaire > Tacit Renewal ?
Que dois-je compléter puisque vous avez-vous même ajouté les instructions nécessaires pour le champ supplémentaire > Tacit Renewal ?
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
14 août 2017 à 07:46
14 août 2017 à 07:46
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.
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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
14 août 2017 à 11:25
14 août 2017 à 11:25
Bonjour,
Et où sera stockée votre adresse Email ?
Et où sera stockée votre adresse Email ?
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
14 août 2017 à 11:41
14 août 2017 à 11:41
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.
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.
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
14 août 2017 à 17:40
14 août 2017 à 17:40
Ceci devrait donc faire l'affaire (à tester)
UF New identification
Module d'envoi mail
UF New identification
Private Sub Term_Evts_TermDocs()
'....................................
'envoi mail
destinataire_CCI = "abc@travail.com"
Call envoi_mail(destinataire_A, objet, html_texte, erreur, ending_date, destinataire_CC, destinataire_CCI)
'....................................
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
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
15 août 2017 à 10:44
15 août 2017 à 10:44
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 & ",<br><br>"
html_texte = html_texte & "Thank you for your registration and welcome to the Purchasing Contractual Database <br>"
html_texte = html_texte & " Please find below your login details : <br><br>"
html_texte = html_texte & "Last name : " & Me.LAST_NAME & "<br>First name : " & Me.FIRST_NAME & "<br>"
html_texte = html_texte & "Password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & "<br>"
html_texte = html_texte & "<br><br>*** 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 !
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 & ",<br><br>"
html_texte = html_texte & "Thank you for your registration and welcome to the Purchasing Contractual Database <br>"
html_texte = html_texte & " Please find below your login details : <br><br>"
html_texte = html_texte & "Last name : " & Me.LAST_NAME & "<br>First name : " & Me.FIRST_NAME & "<br>"
html_texte = html_texte & "Password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & "<br>"
html_texte = html_texte & "<br><br>*** 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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
Modifié le 15 août 2017 à 11:24
Modifié le 15 août 2017 à 11:24
Le contenu de ending_date doit être vide..
ending_date = Range("Ending_date_of_the_document").Rows(dates.Row)
Peut être que le nom de plage "Ending_date_of_the_document" ne renvoie pas à la bonne colonne.
Pour éviter de prendre en compte un ending_date vide, modifier dans le module Envoi_mail l'instruction
comme suit
ending_date = Range("Ending_date_of_the_document").Rows(dates.Row)
Peut être que le nom de plage "Ending_date_of_the_document" ne renvoie pas à la bonne colonne.
Pour éviter de prendre en compte un ending_date vide, modifier dans le module Envoi_mail l'instruction
If Not IsMissing(échéance) Then Email.ExpiryTime = échéance
comme suit
If Not IsMissing(échéance) And Not IsEmpty(échéance) Then Email.ExpiryTime = échéance
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
>
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
15 août 2017 à 11:56
15 août 2017 à 11:56
Nickel !
Merci beaucoup.
Et derniere chose (je suis du genre à beaucoup abuser :)
Si à terme, je décide de mettre en cc le manager de la personne qui vient de s'inscrire à l'outil, est ce que le code adapté ci-dessous serait conforme ?
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_CC = Me.EMAIL_MANAGER
destinataire_CCI = "nicolas.delarbre@bobst.com"
objet = "Your login details for the Purchasing Contractual Database"
html_texte = "Dear " & Me.FIRST_NAME & " " & Me.LAST_NAME & ",<br><br>"
html_texte = html_texte & "Thank you for your registration and welcome to the Purchasing Contractual Database <br>"
html_texte = html_texte & " Please find below your login details : <br><br>"
html_texte = html_texte & "Last name : " & Me.LAST_NAME & "<br>First name : " & Me.FIRST_NAME & "<br>"
html_texte = html_texte & "Password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & "<br>"
html_texte = html_texte & "<br><br>*** 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 DPTMT_Change()
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
Après un test, ca a l'air de marcher...
Encore merci,
Merci beaucoup.
Et derniere chose (je suis du genre à beaucoup abuser :)
Si à terme, je décide de mettre en cc le manager de la personne qui vient de s'inscrire à l'outil, est ce que le code adapté ci-dessous serait conforme ?
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_CC = Me.EMAIL_MANAGER
destinataire_CCI = "nicolas.delarbre@bobst.com"
objet = "Your login details for the Purchasing Contractual Database"
html_texte = "Dear " & Me.FIRST_NAME & " " & Me.LAST_NAME & ",<br><br>"
html_texte = html_texte & "Thank you for your registration and welcome to the Purchasing Contractual Database <br>"
html_texte = html_texte & " Please find below your login details : <br><br>"
html_texte = html_texte & "Last name : " & Me.LAST_NAME & "<br>First name : " & Me.FIRST_NAME & "<br>"
html_texte = html_texte & "Password : " & Sheets("Data base Entreprise").Range("H" & Ligne) & "<br>"
html_texte = html_texte & "<br><br>*** 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 DPTMT_Change()
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
Après un test, ca a l'air de marcher...
Encore merci,
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
Modifié le 15 août 2017 à 13:50
Modifié le 15 août 2017 à 13:50
Cela devrait fonctionner car ces instructions effaceront
destinataire_A = Me.E_MAILcelles situées en amont
destinataire_CC = Me.EMAIL_MANAGER
destinataire_A = infos_doc(1)--
destinataire_CC = infos_doc(2)
Niconz
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
Modifié le 15 août 2017 à 14:38
Modifié le 15 août 2017 à 14:38
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 :
![](https://img-19.ccm2.net/RXZqoZ8AsvDrXcyjgSjfdjSFh4E=/440x/fe22cf4fe6a141bf9b954f558646637f/ccm-ugc/Capture.PNG)
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.
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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
15 août 2017 à 20:51
15 août 2017 à 20:51
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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
16 août 2017 à 07:47
16 août 2017 à 07:47
Bonjour Thev,
J'ai désormais le message d'erreur suivant :
erreur : the object does not support this method. destinataire = mon adresse email
Merci.
J'ai désormais le message d'erreur suivant :
erreur : the object does not support this method. destinataire = mon adresse email
Merci.
thev
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
Modifié le 16 août 2017 à 11:50
Modifié le 16 août 2017 à 11:50
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
Messages postés
310
Date d'inscription
lundi 16 juin 2014
Statut
Membre
Dernière intervention
6 juillet 2020
16 août 2017 à 14:53
16 août 2017 à 14:53
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.
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
Messages postés
1855
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
13 mai 2024
683
Modifié le 16 août 2017 à 20:12
Modifié le 16 août 2017 à 20:12
On va procéder différemment. Vous mettez en commentaire dans le module Envoi_mail les lignes suivantes :
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.
'....... 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.