matthieu2701
XLDnaute Occasionnel
Bonjour,
Dans le chemin "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours\" j'ai le dossier de plusieurs clients. Chaque dossier contient des documents Word et pdf.
Les deux document que j'ai besoin de joindre à mon mail sont Nom Engagement de paiement.docx et Nom.doc.
J'ai cette macro qui fonctionne avec Lotus Note.
Mon soucis vient du fait que je souhaite mettre en pièce jointe le fichier Nom.doc seulement, s'il est seul dans le dossier du client ou Nom.doc + Nom Engagement de Paiement.docx si les deux sont dans le dossier.
Je n'arrive pas à écrire le code avec IF. Voici le bout du code
Avec ça, si j'ai les deux fichiers tous fonctionne, par contre si j'ai pas Nom Engagement de Paiement.docx cela ne fonctionne pas. De plus, si le fichier Nom.doc n'existe pas (Celui ci est obligatoire), je souhaite une msgbox "Le document word n'a pas été créé."
Voici le code complet
Merci par avance pour votre aide.
Dans le chemin "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours\" j'ai le dossier de plusieurs clients. Chaque dossier contient des documents Word et pdf.
Les deux document que j'ai besoin de joindre à mon mail sont Nom Engagement de paiement.docx et Nom.doc.
J'ai cette macro qui fonctionne avec Lotus Note.
Mon soucis vient du fait que je souhaite mettre en pièce jointe le fichier Nom.doc seulement, s'il est seul dans le dossier du client ou Nom.doc + Nom Engagement de Paiement.docx si les deux sont dans le dossier.
Je n'arrive pas à écrire le code avec IF. Voici le bout du code
PHP:
If FichierJoint <> "" Then
Set AttachME = LeMail.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint, "Attachment")
End If
If FichierJoint2 <> "" Then
Set AttachME = LeMail.CreateRichTextItem("Attachment2")
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint2, "Attachment2")
End IfAvec ça, si j'ai les deux fichiers tous fonctionne, par contre si j'ai pas Nom Engagement de Paiement.docx cela ne fonctionne pas. De plus, si le fichier Nom.doc n'existe pas (Celui ci est obligatoire), je souhaite une msgbox "Le document word n'a pas été créé."
Voici le code complet
PHP:
Public Sub Lancement_Nimes()
Call RoutineEnvoiMailLotus_Nimes
End Sub
Public Sub RoutineEnvoiMailLotus_Nimes()
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--------------- : "
End With
'With Sheets("Echéancier")
'If Centre = 241 Or Centre = 242 Or Centre = 243 Or Centre = 245 Or Centre = 253 Or Centre = 254 Or Centre = 259 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
If Dir("Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours\" & "\" & Nom & " " & PCE, 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 = "PDD - Dossier numérique" & " - " & "PCE " & PCE '
Destinataires(0) = "xxx@xxxfr"
'Destinataires(1) = ""
'--------------------------------------------------------
'Personne en copie
ccDestinataires(0) = ""
ccDestinataires(1) = ""
'--------------------------------------------------------
'--------------------------------------------------------
'Personne en copie cachée
cccDestinataires(0) = ""
'cccDestinataires(1) = AutreDestinaire
'--------------------------------------------------------
Fichier$ = Nom & ".doc" '"NomDuFichier.xls"
chemin$ = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE ' chemin du fichier exp: = ThisWorkbook.Path
If chemin$ > "" And Right(chemin$, 1) <> "\" Then chemin$ = chemin$ & "\"
FichierJoint = chemin$ & Fichier$
Fichier2 = Nom & " " & "Engagement de Paiement.docx"
chemin2 = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE
If chemin2 > "" And Right(chemin2, 1) <> "\" Then chemin2 = chemin2 & "\"
FichierJoint2 = chemin2 & Fichier2
'ou
'FichierJoint = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name
'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(" Dossier Numérique")
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("------------------------------------------------------------------------------------------------------------------------------------")
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 FichierJoint2 <> "" Then
Set AttachME = LeMail.CreateRichTextItem("Attachment2")
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint2, "Attachment2")
End If
'Envoie le mail
LeMail.Send 0
'LIBERE LES OBJETS
Call Fin_Notes_Envoi
Erase Destinataires()
Erase ccDestinataires()
Erase cccDestinataires()
'ActiveSheet.Shapes("MonBouton4").Visible = True
'Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage4"
End Sub
'Sub EffacerMessage4()
'ActiveSheet.Shapes("MonBouton4").Visible = False
'End SubMerci par avance pour votre aide.
Dernière édition:
