matthieu2701
XLDnaute Occasionnel
Bonjour,
J'ai une macro pour l'envoi de mail à partir de Lotus notes. Nous venons de changer de messagerie et je suis passer sous outlook.
J'aurais besoin de votre aide pour modifier ma macro pour qu'elle fonctionne sous outlook.
Je vous remercie par avance de votre aide.
J'ai une macro pour l'envoi de mail à partir de Lotus notes. Nous venons de changer de messagerie et je suis passer sous outlook.
J'aurais besoin de votre aide pour modifier ma macro pour qu'elle fonctionne sous outlook.
Je vous remercie par avance de votre aide.
Code:
Public Sub Lancement_LARO241242()
Call RoutineEnvoiMailLotus_LARO241242
End Sub
Public Sub RoutineEnvoiMailLotus_LARO241242()
Application.ScreenUpdating = False
'Perso, je préfère définir des noms sur les cellules plutot que d'utiliser B1, B2...
With Sheets("Echéancier")
Ref = .Range("B1")
Nom = .Range("B2")
Adresse = .Range("B3")
Dette = .Range("D1")
PCE = .Range("G6")
Compteur = .Range("G7")
Matricule = .Range("G8")
Téléphone = .Range("G9")
Commentaire = .Range("G10")
Centre = .Range("G5")
Champ1 = "N° de PCE------------------------ : "
Champ2 = "IGOR------------------------------- : "
Champ3 = "Nom du client----------------- : "
Champ4 = "Adresse de livraison------- : "
Champ5 = "Téléphone du client------- : "
Champ6 = "Compteur sur place------- : "
Champ7 = " matricule : "
Champ8 = "Montant------------------------ : "
Champ9 = "Echéancier------------------- : "
Champ10 = "Commentaire--------------- : "
ObjetMailFige = .Range("G14")
ObjetMailLibre = .Range("G15")
End With
With Sheets("Echéancier")
If Centre = 251 Or Centre = 252 Or Centre = 256 Or Centre = 258 Or Centre = 253 Or Centre = 254 Or Centre = 259 Or Centre = 243 Or Centre = 245 Then
MsgBox "Centre incorrect", vbCritical, "Attention"
Exit Sub
End If
If PCE = "" Or Compteur = "Oui" And Matricule = "" Or Téléphone = "" Or Commentaire = "" Or Ref = "" Or Nom = "" Or Adresse = "" Or Dette = "" Then
MsgBox "Veuillez Remplir tous les champs avant d'envoyer le mail", vbOKOnly + vbCritical, "Attention"
Exit Sub
Else
'NNI des agents
'Marignane
Matthieu = "B....."
Yacine = "J....."
Sophie = "d...."
Maxence = "J....."
Remi = "f......"
Camille = "c......"
Cindy = "c....."
Sarah = "s......"
Priscilla = "d...."
Priscilla2 = "D...."
Zoe = "F...."
Elodie = "d...."
Virginie = "D...."
Daniel = "h....."
Nathalie = "b...."
Alexandre = "i...."
Stephane = "a...."
Florent = "C...."
Anais = "G...."
Paola = "e...."
Sanae = "A...."
Marine = "F...."
AnaisG = "h...."
'Nimes
Claudia = "j...."
Magali = "J...."
Karina = "J...."
Eric = "J...."
Celine = "A...."
Betty = "A...."
'Recherche de l'utilisateur qui a ouvert la session
utilisateur = Environ("username")
Select Case utilisateur
Case Matthieu, Yacine, Sophie, Maxence, Remi, Camille, Cindy, Sarah, Priscilla, Priscilla2, Zoe, Elodie, Daniel, Nathalie, Alexandre, Stephane, Florent, Anais, Paola, Sanae, Marine, AnaisG
chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE
chemin2 = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\"
fichier = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE & "\" & Nom & " Engagement de Paiement.docx"
Case Virginie
chemin = "G:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE
chemin2 = "G:\AAGP2\PDD GAZ\PDD\Dossiers PDD\"
fichier = "G:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE & "\" & Nom & " Engagement de Paiement.docx"
Case Fabienne, Claudia, Magali, Karina, Eric, Celine, Betty
chemin = "Q:\AAG\DOSSIERS NUMERIQUES PDD" & "\" & Nom & " " & PCE
chemin2 = "Q:\AAG\DOSSIERS NUMERIQUES PDD\"
fichier = "Q:\AAG\DOSSIERS NUMERIQUES PDD" & "\" & Nom & " " & PCE & "\" & Nom & " Engagement de Paiement.docx"
End Select
If Dir(fichier, vbDirectory) = "" Then
MsgBox "Le dossier numérique ou l'engagement de paiement de " & Nom & " " & PCE & " n'a pas été créé. Veuillez le créer puis recommencer", vbCritical, "Attention"
Exit Sub
End If
'Application.DisplayAlerts = False '(utiliser aussi pour le sauvegarde)
'ActiveWorkbook.SaveAs Filename:="C:\TEMP\" + NomFichier, FileFormat _
':=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
'False, CreateBackup:=False
'Application.DisplayAlerts = True
'DEFINITION DES DONNEES POUR L'ENVOI DU MESSAGE
'Gestionnaire Habilitation
'tu peux ici déclarer tes variables pour les utiliser pour les destinataires, ou personnes en copie etc.
'Destintaire2 = Sheets("Demande").Range("Destinatarie2").Value
'AutreDestinaire = Sheets("Demande").Range("AutreDestinataire2").Value
Sujet = ObjetMailFige & ObjetMailLibre '
Destinataires(0) = "test@hotmail.fr"
'Destinataires(1) = ""
'--------------------------------------------------------
'Personne en copie
ccDestinataires(0) = ""
'ccDestinataires(1) = Destintaire2
'--------------------------------------------------------
'--------------------------------------------------------
'Personne en copie cachée
cccDestinataires(0) = ""
'cccDestinataires(1) = AutreDestinaire
'--------------------------------------------------------
fichier1 = Nom & " Engagement de Paiement.docx" ' "NomDuFichier.xls"
If chemin > "" And Right(chemin, 1) <> "\" Then chemin = chemin & "\"
FichierJoint = chemin & fichier1
Fichier2 = "RIB GRDF.pdf"
FichierJoint2 = chemin2 & Fichier2
'RECUPERATION DE LA SESSION NOTES
Call SendNotesMail
'Si erreur dans le module Init_Notes alors on revient ici et on affiche le message sinon on continue
'If Retour = ERR_NOTES_ERROR Then
'MsgBox " Erreur lors de l'ouverture de la session ", vbExclamation, " Problème "
'Exit Sub
'End If
' Création du message
Set LeMail = BaseMail.CreateDocument
'Déclarations pour la mise en forme du texte (gras, italic...)
Set rtstyle = Session.CreateRichTextStyle
Set rtstyle2 = Session.CreateRichTextStyle
Set colorObject = Session.CreateColorObject
Call LeMail.AppendItemValue("Form", "Memo")
Call LeMail.AppendItemValue("sendTo", Destinataires)
Call LeMail.AppendItemValue("CopyTo", ccDestinataires)
Call LeMail.AppendItemValue("BlindCopyTo", cccDestinataires)
Call LeMail.AppendItemValue("Subject", Sujet)
'LeMail.SaveMessageOnSend = True
Set Body = LeMail.CreateRichTextItem("Body")
'******************************************************************************
'Personnalisation du message envoyé
rtstyle.Bold = True
rtstyle.Italic = True
rtstyle.NotesFont = 2
rtstyle.FontSize = 10
rtstyle2.Bold = False
rtstyle2.Italic = False
'******************************************************************************
'Message$ = "Bonjour," & vbCrLf & vbCrLf & "Je t 'envoie les informations concernant le rétablissement gaz suite PDD." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _
'"1 - IDENTIFICATION DU CLIENT / DEMANDE" & _
'vbCrLf & vbCrLf & vbCrLf & vbCrLf & Champ1 & PCE & vbCrLf & vbCrLf & Champ2 & Ref & vbCrLf & vbCrLf & Champ3 & Nom & vbCrLf & vbCrLf & Champ4 & Adresse & vbCrLf & vbCrLf & Champ5 & _
'"0" & Téléphone & vbCrLf & vbCrLf & Champ6 & Compteur & " " & Champ7 & Matricule & vbCrLf & vbCrLf & Champ8 & FormatNumber(Dette, 2) & vbCrLf & vbCrLf & Champ9 & _
'"Voir PiÃ_ce jointe" & vbCrLf & vbCrLf & Champ10 & Commentaire & vbCrLf & vbCrLf & "Cordialement" 'message
' Fichier$ = Nom & " Engagement de Paiement.docx" ' "NomDuFichier.xls"
' Chemin$ = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours\" & "\" & Nom & " " & Ref ' chemin du fichier exp: = ThisWorkbook.Path
' If Chemin$ > "" And Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\"
Call Body.AppendText("Bonjour,")
Call Body.AddNewLine(2)
Call Body.AppendText("Je t 'envoie les informations concernant le rétablissement gaz suite PDD.")
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------")
Call Body.AppendStyle(rtstyle2)
Call Body.AddNewLine(1)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(" 1 - IDENTIFICATION DU CLIENT / DEMANDE")
Call Body.AppendStyle(rtstyle2)
Call Body.AddNewLine(1)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------")
Call Body.AppendStyle(rtstyle2)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ1)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(PCE)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ2)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Ref)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ3)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Nom)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ4)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Adresse)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ5)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Format(Téléphone, "0000000000"))
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ6)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Compteur)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ7)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Matricule)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ8)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(FormatNumber(Dette, 2))
Call Body.AppendText(" euros")
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ9)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText("Voir pièce jointe")
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(Champ10)
Call Body.AppendStyle(rtstyle2)
Call Body.AppendText(Commentaire)
Call Body.AddNewLine(2)
Call Body.AppendStyle(rtstyle)
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------")
Call Body.AppendStyle(rtstyle2)
Call Body.AddNewLine(2)
Call Body.AppendText("Bonne Réception.")
Call Body.AddNewLine(2)
Call Body.AppendText("Cordialement")
Call Body.AddNewLine(2)
'tu ouvres avec ce style
Call Body.AppendStyle(rtstyle)
Call Body.AppendText(EmetteurA)
'tu fermes avec ce style
Call Body.AppendStyle(rtstyle2)
Call Body.AddNewLine(2)
LeMail.SaveMessageOnSend = True
LeMail.SaveMessageOnSend = True
'Prend en compte les pièces jointes
If FichierJoint <> "" Then
Set AttachME = LeMail.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint, "Attachment")
End If
If Range("I7") = "virement" Then
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint2, "Attachment")
End If
'Envoie le mail
LeMail.Send 0
'LIBERE LES OBJETS
Call Fin_Notes_Envoi
ActiveSheet.Shapes("MonBouton").Visible = True
Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage8"
Erase Destinataires()
Erase ccDestinataires()
Erase cccDestinataires()
End If
End With
End Sub
Sub EffacerMessage8()
ActiveSheet.Shapes("MonBouton").Visible = False
MsgBox "Avez-vous pensez à appeler la CPC pour programmer l'intervention ?", vbCritical, "Attention"
Sheets("Echéancier").Range("K1").Value = Format(Now, "dddd dd mmmm yyyy / h:mm")
Sheets("Echéancier").Range("K2").Value = Environ("username")
Call Enregistrer_Classeur
Sheets("Echéancier").Range("K4").Value = Format(Now, "dddd dd mmmm yyyy / h:mm")
End Sub
Dernière édition: