[XL-2003] Mail via Lotus note

Tiens voici le code que j'utilisais avec lotus notes

code à modifier avec tes données
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
' --------- 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 décisionMailLotus()
Application.ScreenUpdating = False
ActiveWorkbook.Save
 
'demande numero de produits isolés
On Error GoTo FinMail
numero = InputBox(PROMPT:="Numéro", Title:="Numéro du produits isolés")
Sheets("Mes (2)").Activate
Range("f1").Select
Selection.Value = numero
 
'------- compléter les variables nécessaires pour envoi --------------
AdresDestinataire$ = "toto@truc.fr" 'si plusieurs adresses séparer par le point virgule !
Sujet$ = "DECISION (" & numero & "_10/11)" '& Format(Now(), "dd.mm.yyyy") ' sujet
 
'MESSAGE : 1er façon
Message$ = ""
For Lig = 1 To 35
Message$ = Message$ & Sheets("Mes (2)").Cells(Lig, 1) & Sheets("Mes (2)").Cells(Lig, 2) & vbLf
Next
 
'MESSAGE : 2ème façon
'Message$ = "Bonjour," & vbCrLf & vbCrLf _
'& "Ci joint analyse du jour " & vbCrLf & vbCrLf _
'& "Cet e-mail a été généré par un processus automatique." & vbCrLf & vbCrLf _
'& "" 'message
 
'Fichier$ = "feuille journalière.xls" ' "NomDuFichier.xls"
'Chemin$ = "R:\Dcond\Laboratoire\Résultats des analyses\2010" ' 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
    Document.ReturnReceiptMessage = True ' Pour avoir un accusé de réception "1" pour A/R et "0" sans A/R
    'reinit adresse suivante !?
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
 End If
Next
MsgBox "Le message a été envoyé", vbInformation, "MESSAGE LOTUS ..."
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
 
Sheets("base de données").Activate
End Sub