matthieu2701
XLDnaute Occasionnel
Bonjour,
Je souhaite créer un mail sur Lotus Notes à l'aide d'une macro excel. Le mail se cré mais impossible de faire une mise en forme.
Comment faire pour modifier le "message$" pour qu'il soit au format HTML ?
Voici ma macro
Merci par avance.
Je souhaite créer un mail sur Lotus Notes à l'aide d'une macro excel. Le mail se cré mais impossible de faire une mise en forme.
Comment faire pour modifier le "message$" pour qu'il soit au format HTML ?
Voici ma macro
PHP:
' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence [x]Lotus Domino Objects .
Public Sub RoutineEnvoiMailLotus()
Application.ScreenUpdating = False
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")
Champ1 = .Range("F13")
End With
With Sheets("Echéancier")
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
'------- compléter les variables nécessaires pour envoi --------------
AdresDestinataire$ = "xxxx@xxxx.fr" 'si plusieurs adresses séparer par le point virgule !
Sujet$ = "Rétablissement PDD" & " - " & "PCE " & PCE ' sujet
Message$ = "Bonjour," & vbCrLf & vbCrLf & "Je t 'envoie les informations concernant le rétablissement gaz suite PDD." & vbCrLf & vbCrLf & "1 - IDENTIFICATION DU CLIENT / DEMANDE" & vbCrLf & vbCrLf & Champ1 & PCE & vbCrLf & vbCrLf & " IGOR--------------------------: " & Ref & vbCrLf & vbCrLf & "Nom du client-----------------: " & Nom & vbCrLf & vbCrLf & "Adresse de livraison----------: " & Adresse & vbCrLf & vbCrLf & "Téléphone du client-----------: 0" & Téléphone & vbCrLf & vbCrLf & "Compteur sur place------------: " & Compteur & " " & " Matricule : " & Matricule & vbCrLf & vbCrLf & "Montant-----------------------: " & FormatNumber(Dette, 2) & vbCrLf & vbCrLf & "Echéancier-------------------: Voir Pièce jointe " & vbCrLf & vbCrLf & "Commentaire-------------------: " & Commentaire '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$ & "\"
CheminEtFichier$ = Chemin$ & Fichier$
'------ départ envoi messagerie --------
'met en tableau si plusieurs adresses !?
If InStr(AdresDestinataire$, ";") = 0 Then AdresDestinataire$ = AdresDestinataire$ & ";"
Dim TabloAdresDestin As Variant
TabloAdresDestin = Split(AdresDestinataire$, ";")
'------ préparation session ------
On Error GoTo ErreurNET: Err.Clear
Dim oSession As Object 'CreateObject("Notes.NotesSession")
Dim UserName As String 'Nom d'utilisateur
Dim DataBase As Object 'Base des mails
Dim DataBaseName As String 'Nom de la base
Dim Document As Object 'Mail
Dim AttachME As Object 'Fich joint en RTF
Dim AttachF1 As Object '1' pièce attachée
' Création de la session
Set oSession = CreateObject("Notes.NotesSession")
' Récupèration du nom d'utilisateur
UserName = oSession.UserName
DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
' Ouvre la base des mails (si fermé, ouvre et demande le password)
Set DataBase = oSession.GetDataBase("", DataBaseName)
If Not DataBase.IsOpen Then DataBase.OpenMail
' boucle envoi au(x) destinataire(s)
For I = LBound(TabloAdresDestin) To UBound(TabloAdresDestin)
If Trim(TabloAdresDestin(I)) > "" Then
AdresDestinataire$ = TabloAdresDestin(I)
'crée le document et colle /AdresDestinataire /Sujet /Message
Set Document = DataBase.CreateDocument
Document.Form = "Memo"
Document.Sendto = AdresDestinataire$
Document.Subject = Sujet$
Document.body = Message$
'Joint le Fichier s'il y a !?
If CheminEtFichier$ <> "" Then
Set AttachME = Document.CreateRichTextItem("Attachment")
Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
End If
'Envoi le Mail
Document.SaveMessageOnSend = True 'True = save dans les courriers envoyés
Document.PostedDate = Now() ' date du jour
Document.Send 0, AdresDestinataire$ 'envoi
'reinit adresse suivante !?
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
End If
Next
GoTo FinMail ' fin ########################################################
ErreurNET:
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
t$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, t$, Err.HelpFile, Err.HelpContext
GoTo FinMail
FinMail:
'libère les variables Object
Set oSession = Nothing: Set DataBase = Nothing
Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
End If
End With
End subMerci par avance.
