Hello to all
I have a code VBA to create an e-mail on notes, but this one do not allow a correct shaping of the message
[code]Sub CreateNotesMsg(VPathFic)
'***********************************************
'Objet : Edition d’un message créé dans Notes
'***********************************************
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim WorkSpace As Object
Dim ntsServer As String
Dim ntsMailFile As String
Dim sSendTo As String, sCopyTo As String
Dim sSubject As String
Dim sBodyText As String
’
On Error GoTo err_CreateNotesMsg
’ Initialisation des variables
sSendTo = ThisWorkbook.Sheets(“Params”).Range(“AdrEnvoi”)
sCopyTo = ThisWorkbook.Sheets(“Params”).Range(“AdrCopie”)
sSubject = "Envoi de PAF signés " & Format(Now(), “dd.mm.yyyy hh:mm”)
’ Créer la session Notes
Set oSess = CreateObject(“Notes.NotesSession”)
’ Récupérer les infos serveur
ntsServer = oSess.GetEnvironmentString(“MailServer”, True)
'Acquière le nom du fichier mailfile de l’utilisateur courant dans Notes.ini
ntsMailFile = oSess.GetEnvironmentString(“MailFile”, True)
Set oDB = oSess.GetDatabase(ntsServer, ntsMailFile)
’ Vérifier si la base est ouverte
If oDB.IsOpen = False Then oDB.OPENMAIL
’ Crée le nouveau document
Set oDoc = oDB.CreateDocument
oDoc.Form = “Memo”
’ Inscrire la/les adresse(s) d’envoi
oDoc.AppendItemValue “SendTo”, sSendTo
’ Eventuellement la/les adresse(s) de copie
If Not IsMissing(sCopyTo) Then
oDoc.AppendItemValue "CopyTo", sCopyTo
End If
’ Inscrire le sujet du mail
If Not IsMissing(sSubject) Then
If sSubject <> "" Then oDoc.AppendItemValue "Subject", sSubject
End If
’ Attacher le fichier de bordereau
Set oItem = oDoc.CreateRichTextItem(“Attachment”)
Call oItem.EmbedObject(1454, “”, VPathFic, “Attachment”)
’ Créer le corps du message
Set oItem = oDoc.CreateRichTextItem(“BODY”)
’ Inscire le texte
With oItem
.AppendText "Bonjour,"
.AddNewline 1
.AppendText "Vous trouverez ci-joint le bordereau d'envoi,"
.AppendText "ainsi que les PAF signés"
.AddNewline 1
End With
Set oItem = oDoc.CreateRichTextItem(“BODY2”)
’ Ouvrir l’espace de travail
Set WorkSpace = CreateObject(“Notes.NotesUIWorkspace”)
Call WorkSpace.EditDocument(True, oDoc)
exit_CreateNotesMsg:
On Error Resume Next
Set oItem = Nothing
Set oDoc = Nothing
Set oDB = Nothing
Set oSess = Nothing
Exit Sub
err_CreateNotesMsg:
ErrLotus = True
If Err.Number = 7225 Then
MsgBox "Impossible d'attacher le fichier, vérifier le chemin!", vbCritical
Else
MsgBox "[" & Err.Number & "]: " & Err.Description
End If
MsgBox “Message non envoyé suite erreur!”, vbCritical
Resume exit_CreateNotesMsg
End Sub[/code]
Could you help me ?
Cordially.