Amélioration Code Excel vers Lotus Notes 6.5
Bonjour,
Je vais essayé d'expliquer clairement mon(mes) problèmes.
J'ai bidouillé un code pour envoyer des mail d'Excel vers Lotus notes 6.5. (Avec tout ce que j'ai pu trouver sur les discussions)
Le code marche très bien, mais il me reste deux points que j'aimerai améliorer:
1- comment empêcher de demander le mot de passe de lotus note si il est déjà ouvert sur le poste. Les utilisateur de ce fichier ont Lotus notes ouvert toutes la journée (P.S:c'est le même mot de passe que la connexion window) Récupérer automatiquement le mot de passe de Lotus notes sur la connexion en cours ?
2-J'arrive a mettre un document en PJ dans les @mail mais pas le raccourci de ce document.Je veux que les destinataires du mail puisse accéder directement au fichier source via le mail
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Sub Mail()
'Set up the objects required for Automation into lotus notes
Dim Maildb As NotesDatabase 'The mail database
Dim MailDoc As Object 'The mail document itself
Dim oSession As NotesSession
Dim dbDirectory As NotesDbDirectory
Dim objNotesField As Object
Dim message, title, defaultValue As String
Dim Mail
Dim MonTo(1 To 3) As String
Dim r As Long
Dim AttachME As Object
Dim EmbedObj As Object
Dim ATTACHMENT
On Error GoTo ErrHandle
'=================================Tableau Adresses Mail DESTINATAIRE======================================================
r = Sheets("LISTES").Cells(Sheets("LISTES").Columns(5).Cells.Count, 1).End(xlUp).Row 'récupère la dernière ligne remplie de la feuille 2 pour la plage de recherche
For I = 1 To r
MonTo(I) = Sheets("LISTES").Range("E" & I)
Next I
'=======================================================================================================
'LIEN EN PJ
ATTACHMENT = "P:\DEMANDES COURANTES ELEC\DEMANDES COURANTES ELEC..xls"
'MDP LOTUS NOTES
message = "MOT DE PASSE LOTUS:"
title = "MOT DE PASSE"
defaultValue = "" ' Set default value.
'MDP LOTUS NOTES
MDP = InputBox(message, title, defaultValue)
'MESSAGE DU MAIL
Msg = Sheets("SAISIE").Range("E8") & ": " & Sheets("SAISIE").Range("F8") & Chr(13) & Chr(13) & Sheets("SAISIE").Range("E9") & ": " & Sheets("SAISIE").Range("F9") & Chr(13) & Chr(13) & Sheets("SAISIE").Range("E10") & ": " & Sheets("SAISIE").Range("F10")
'Démarre une session de notes
Set oSession = New NotesSession
'La ligne suivante ne marche qu'avec les versions 5.x et 6.x , c'est l'injection du mot de passe
oSession.Initialize ("" & MDP & "")
'Ouvre la base mail en utilisant le serveur par défaut
Set dbDirectory = oSession.GetDbDirectory("C:\Documents and Settings\All Users\Bureau")
Set Maildb = dbDirectory.OpenMailDatabase
'Création du formulaire d'envoi de mail
Set MailDoc = Maildb.CreateDocument()
MailDoc.AppendItemValue "Subject", "Evolution du fichier des DEMANDES COURANTES " & Chr(13) & Sheets("SAISIE").Range("E8") & ": " & Sheets("SAISIE").Range("F8") & Chr(13) & Sheets("SAISIE").Range("E9") & ": " & Sheets("SAISIE").Range("F9") & Chr(13) & Sheets("SAISIE").Range("E10") & ": " & Sheets("SAISIE").Range("F10")
MailDoc.AppendItemValue "SendTo", MonTo
MailDoc.AppendItemValue "ReturnReceipt", "1"
MailDoc.SaveMessageOnSend = SaveIt
If ATTACHMENT <> "" Then
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", ATTACHMENT, "Attachment")
End If
Set objNotesField = MailDoc.CreateRichTextItem("Body")
With objNotesField
.AppendText Msg
End With
'Envoi le document
If SaveIt = True Then
MailDoc.SaveMessageOnSend = SaveIt 'si à True, Lotus sauvegarde le mail envoyé
End If
Call MailDoc.Send(False)
GoTo ExitHandle
ErrHandle:
MsgBox Err.Description
ExitHandle:
'Vidage mémoire
Set Maildb = Nothing
Set MailDoc = Nothing
Set oSession = Nothing
Set dbDirectory = Nothing
Set objNotesField = Nothing
End Sub |
Si quelqu'un a des pistes à me transmettre, ça serait sympa.
Merci