Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

[AntoineDG95]

Bonjour à tous,

Je me permets de poster sur ce forum car j'aurai besoin de l'aide des experts de ces lieux afin de modifier une macro existante que j'ai pu trouver sur ce forum.

Je cherche à travers Excel Préparer un envoi de mail sur Lotus sans l'envoyer afin que l'utilisateur puisse réaliser les différents contrôle avant un envoi (voir y inclure une pièce jointe manuellement).

J'ai récupéré une macro permettant de paramétrer un envoi mais celle-ci procède directement à l'envoi malgré mes tentatives de désactiver cette option.

Je vous joins ci-dessous le code VBA de cette application et je vous remercie d'avance de m'aider sur ce petit problème.

Je vous souhaite une excellente journée !

Bien à vous ! Antoine


Option Explicit

Public Sub CreateMailWithCopy(strSubject As String, SendTo As Variant, Body As Variant, SendCopyTo As Variant)
'********************************************'
' '
' création d'un mail sans envoi par la macro '
' '
'********************************************'
Dim OLESess As Object
Dim OLEWorkspace As Object
Dim OLEUIDoc As Object
Dim blnFirst As Boolean
Dim rngCell As Range

On Error GoTo Error_CreateMailWithCopy

' Creation de la connexion avec Lotus Notes et du mail
Set OLESess = CreateObject("notes.NotesSession")
Set OLEWorkspace = CreateObject("Notes.NotesUIWorkspace")
Set OLEUIDoc = OLEWorkspace.COMPOSEDOCUMENT("", "", "Memo")

' remplissage du champ 'To'
OLEUIDoc.GOTOFIELD "To"
blnFirst = True
For Each rngCell In SendTo
If blnFirst Then
If Not IsEmpty(rngCell) Then
OLEUIDoc.FIELDSETTEXT "EnterSendTo", rngCell.Value
blnFirst = False
End If
Else
If Not IsEmpty(rngCell) Then
OLEUIDoc.FIELDAPPENDTEXT "EnterSendTo", "," & rngCell.Value
End If
End If
Next

' remplissage du champ 'cc'
OLEUIDoc.GOTOFIELD "CC"
blnFirst = True
For Each rngCell In SendCopyTo
If blnFirst Then
If Not IsEmpty(rngCell) Then
OLEUIDoc.FIELDSETTEXT "EnterCopyTo", rngCell.Value
blnFirst = False
End If
Else
If Not IsEmpty(rngCell) Then
OLEUIDoc.FIELDAPPENDTEXT "EnterCopyTo", "," & rngCell.Value
End If
End If
Next
On Error GoTo Error_CreateMailWithCopy

' remplissage du champ Subject
OLEUIDoc.FIELDSETTEXT "Subject", strSubject

' positionnement sur le champ Body
OLEUIDoc.GOTOFIELD "Body"
' copy de la zone définie dnas Excel
Body.Copy

' les 4 lignes ci-dessous sont à mettre en commentaire
' si on souhaite (manuellement) coller les données au format bitmap dans Notes
OLEUIDoc.Paste ' coller les données dans Notes
Application.CutCopyMode = False ' désélection de la zone copiée dans Excel
OLEUIDoc.Send True ' envoyer le mail
OLEUIDoc.Close ' fermer le mail

Exit_CreateMailWithCopy:
On Error Resume Next
Set OLESess = Nothing: Set OLEWorkspace = Nothing: Set OLEUIDoc = Nothing
Application.StatusBar = ""
Exit Sub

Error_CreateMailWithCopy:
If Err.Number = 7412 Then
MsgBox "In order to fill correctly mail fields, please select your Inbox," & vbLf & "not Market Risk - Inbox", vbExclamation, ThisWorkbook.Name
Else
MsgBox "Mail hasn't been correctly created.", vbExclamation, "ATTENTION !!!!!!!!!!!!"
GoTo Exit_CreateMailWithCopy
End If
End Sub

Public Sub SendLotusNotesEmail(strSubject As String, varTo As Variant, Optional varCC As Variant, _
Optional rngBody As Range, Optional varAttachment As Variant)
'*****************************'
' '
' création et envoi d'un mail '
' '
'*****************************'
Dim objSession As Object
Dim objLotusDB As Object
Dim objLotusDoc As Object
Dim objLotusItem As Object
Dim blnFlag As Boolean
Dim lngL As Integer
Dim strTempFile As String
Dim rngPlage As Range

On Error GoTo Error_SendAttachement

' répertoire temporaire WINDOWS
strTempFile = Environ("temp")
If Right(strTempFile, 1) <> "\" Then
strTempFile = strTempFile & "\"
End If

Application.Cursor = xlWait
Application.StatusBar = "Opening Lotus Notes..."

Set objSession = CreateObject("notes.notessession")
Set objLotusDB = objSession.GetDatabase("", "")
objLotusDB.OPENMAIL

blnFlag = True
If Not (objLotusDB.IsOpen) Then blnFlag = objLotusDB.Open("", "")
If Not blnFlag Then
MsgBox "Can't open mail file: " & objLotusDB.server & " " & objLotusDB.filepath
End If

Application.StatusBar = "Building Message..."

Set objLotusDoc = objLotusDB.CreateDocument
Set objLotusItem = objLotusDoc.CreateRichTextItem("BODY")
objLotusDoc.Form = "Memo"
objLotusDoc.Subject = strSubject

' utiliser obligatoirement un tableau de String,
' un tableau de Variant ne fonctionne pas
objLotusDoc.SendTo = CStr(varTo)
If Not IsMissing(varCC) Then
objLotusDoc.copyto = varCC
End If

If Not IsMissing(rngBody) Then
objLotusDoc.Body = rngBody
End If

If Not IsMissing(varAttachment) Then
' create attachment
Application.StatusBar = "Attaching file: " & varAttachment
objLotusItem.EmbedObject 1454, "", varAttachment
End If
Application.StatusBar = "Sending message"
objLotusDoc.PostedDate = Now()
objLotusDoc.SaveMessageOnSend = True ' Gets the mail to appear in the sent items folder
objLotusDoc.Send True

'*****************************
' mise à jour du fichier LOG '
lngL = FreeFile
Open strTempFile & "SentMails.log" For Append As lngL
Print #lngL, Now & vbTab & strSubject & vbTab & varTo '& vbCrLf & varAttachment & vbCrLf
Close #lngL

Exit_SendAttachement:
'On Error Resume Next
Set objSession = Nothing: Set objLotusDB = Nothing: Set objLotusDoc = Nothing: Set objLotusItem = Nothing
Application.Cursor = xlDefault
Application.StatusBar = False
Exit Sub

Error_SendAttachement:
MsgBox "Mail hasn't been sent" & vbLf & vbLf & Err.Description, vbExclamation, "ATTENTION !!!!!!!!!!!!"
Close
GoTo Exit_SendAttachement
End Sub

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

Par ailleurs,

J'aimerai si possible positionner les éléments dans les cellules suivantes:
Destinataires: cellule A1 ("feuil1")
Copie: cellule A2 ("feuil1")
Sujet: cellule A3 ("feuil1")
Corps du message! cellule A4 ("feuil1")

L'idée étant que dans ma procédure, il y aurait potentiellement plusieurs modèles d'email à selon l'étape dans lequelle on se trouve et je souhaiterais ainsi paramétré plusieurs modèles d'email dans une même feuille excel.

Je vous remercie d'avance !

Antoine

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

Je me permets de up le topic!

Merci d'avance !

 

[Roland_M]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

bonsoir,

je n'ai pas lotus mais on peut toujours essayer à la place des .Send
exemple:
OLEUIDoc.Send
objLotusDoc.Send

mettre:
OLEUIDoc.Save
objLotusDoc.Save

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

Bon j'ai pu avancer pour créer uniquement un message dans lotus sans l'envoyer.
J'ai regardé un peu partout sur le net et j'ai adapté le code pour qu'il puisse contenir un long corps de texte dans la cellule F28 du fichier ci-joint

Le problème est que la signature n'apparaît plus en fin d'email comme dans la macro d'origine. La macro d'origine faisait un copier coller très moche qui n'est pas suffisament pro pour les envois que je souhaite réalisé.

Quelqu'un pourrait m'aider à finaliser cette macro. Je sens que j'y suis presque

Je vous remercie d'avance

 

[Roland_M]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

bonsoir,

@AntoineDG95, ce serait bien aussi de savoir si ma proposition est valable ou pas !?

ça encouragerait les réponses je pense !?

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

@Roland_M

Je vous prie de m'excuser. Cela n'a pas fonctionné. J'ai donc tout simplement retiré la ligne mais effectivement c'était bien cette ligne qui commandait l'envoi du mail

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

Je me permets de remonter le topic car je n'ai toujours pas trouvé de réponse à ce jour!

Je vous remercie d'avance

 

[AntoineDG95]

Re : Préparer un mail sans envoi sur Excel pour Lotus Notes 8.5

Je up à nouveau le topic. Toujours en recherche de solution à mon problème. Merci d'avance !!

Antoine