Discussion :

[Denis_67]

Bonjour,

Je souhaiterais envoyer une petite partie de feuille excel en corps de texte mis en forme via Lotus notes.
Je ne cherche pas la sophistication juste un tableau propre.

J'ai trouvé un code qui permet d'envoyer sans mise en forme.
J'ai essayé de l'adapter en formatant les zones de texte basé sur la longueur des textes dans les cellules, mais l'écriture etant proportionnelle, je n'arrive pas à créer des cellules allignées dans le corps de texte Lotus.

Voici le code en cours de test.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
105
106
Option Explicit
 
' --------- Envoi d'un mail avec Lotus Notes ---------- .
'origine du code http://www.lesite.com/forum/154410-pb-vba-corps-de-mail-dans-lotus.html
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .
'entrée du CheminEtFichier s'il y a lieu
'entrée Sujet et Message As String
 
Sub EnvoiMailLocal() '(CheminEtFichier As String, Sujet As String, Message As String)
    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
    Dim i, j, txtbody, CheminEtFichier, Msg$, T$, k, Sep_Ligne, Txt_cell
 
    On Error GoTo ErreurNET: Err.Clear '*****
 
    ' Crée la session
    Set oSession = CreateObject("Notes.NotesSession")
    ' Récupère 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
 
    '########################## envoi ###############################################
    'récupère dans la feuille nommée NomDeLaFeuilDATA$ et le Range nommé "CellDATA_AdresDestinataire"
    'les adresses séparées par ";"
    Dim Tablo As Variant, AdresDestinataire As String
    AdresDestinataire = Sheets("data").Range("b5")
    If InStr(AdresDestinataire, ";") = 0 Then AdresDestinataire = AdresDestinataire & ";"
    Tablo = Split(AdresDestinataire, ";")
    '       boucle envoi                 .
    For i = LBound(Tablo) To UBound(Tablo)
     If Trim(Tablo(i)) > "" Then
        AdresDestinataire = Tablo(i)
 
        'crée le document et colle /AdresDestinataire /Sujet /Message
        Set Document = DataBase.CreateDocument
        Document.Form = "Memo"
        Document.Sendto = AdresDestinataire
        Document.Subject = "Test Envoi Mail depuis Excel"
 
        'définition du corps du message
' j'ajoute la ligne de tableau supérieure
       Sep_Ligne = "======================================================================================"
            txtbody = txtbody & Sep_Ligne & vbLf
 
        ' dans mon test je boucle sur 2 lignes de ma feuille
        For j = 18 To 19
' Je positionne une barre verticale de séparateur de tableau.(début)
            txtbody = txtbody & "|"
 
'Je lis les valeurs des cellules des colonne B à H
            For k = 2 To 7
            Txt_cell = Cells(j, k)
 
' je complete la longueur du texte à 9 carractères.
            While Len(Txt_cell) < 10
            Txt_cell = " " & Txt_cell
            Wend
' je concataine le texte et la balise verticale
            txtbody = txtbody & Txt_cell & "|"
            Txt_cell = ""
            Next k
 
'je passe à la ligne et j'ajoute ma ligne de séparation            
            txtbody = txtbody & vbLf
            txtbody = txtbody & Sep_Ligne & vbLf
 
        Next j
' je passe le texte dans la variable document.body        
        Document.body = txtbody
 
        'Joint le Fichier s'il y en a un !?
        If CheminEtFichier <> "" Then
           Set AttachME = Document.CreateRichTextItem("Attachment")
           Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
        End If
 
        'Envoi le Mail
        Document.SaveMessageOnSend = True 'True svg dans les courriers envoyés
        Document.PostedDate = Now()
        Document.Send 0, AdresDestinataire
        ' suite...
        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:
    Set oSession = Nothing: Set DataBase = Nothing
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
    On Error GoTo 0: Err.Clear
End Sub

C'est simple et efficace mais pas trop beau !!

Sur notre site la disscusion suivante propose une version avec mise en forme et parait intéressante et prometteuse.

http://www.developpez.net/forums/d14...tus-via-excel/

mais là cela dépasse pour l'instant mes capacités, et en testant j'ai une erreur de compilation

type defini par utilisateur non defini

sur les lignes NOTES RCIH etc...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim rtpsCols(3) As NotesRichTextParagraphStyle

Je pense qu'il faut activer des fonctions supplémentaires quelques part ou charger des librairies où comment?
En outre il faudra que chaque utilisateur active ces librairies ? et ca je ne pourrai pas l'assurer

Ou peut-etre existe-t-il une autre méthodes ?

Merci pour vos suggestions
Denis

[Denis_67]

En cherchant, j'ai trouvé une solution relativement simple de codage en html
je l'ai adaptée pour pouvoir envoyer à plusieurs destinataires.

Voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub sendMail2()
    Dim envoyerCc As String, Subject As String
' Je créé un tableau des destinataires faire de meme pour Cc si on veut plusieurs destinatiaires
    Dim SendList(100) As String
' dans l'exemple j'ai forcé les destiantaires mais on peut le lire sur la feuille excel aussi.
    SendList(0) = "denis1@maboite.com"
    SendList(1) = "denis1@maboite.com"
    SendList(2) = "denis1@maboite.com"
    SendList(3) = "denis1@maboite.com"
 
    ' Indiquer ici l'adresse mail à laquelle il faut envoyer le message en copie carbone (Cc) :
    envoyerCc = ""
 
    ' Indiquer ici le sujet de l'e-mail :
    Subject = "Dysfonctionnement N° :" & Cells(2, 2)
 
    Dim s As Object
    Dim docMail As Object
    Dim body As Object
    Dim stream As Object
    Set s = CreateObject("Notes.NotesSession")
 
    Set Db = s.CurrentDatabase
    s.ConvertMIME = False ' Do not convert MIME to rich text
 
    'Create email to be sent
    Set docMail = Db.CreateDocument
 
    With docMail
        .Form = "Memo"
        .SendTo = SendList
        .copyTo = envoyerCc
        .Subject = Subject
        .From = s.COMMONUSERNAME
        .ReplyTo = s.COMMONUSERNAME
        '.Principal = FROM ADDRESS
    End With
 
 
 
    Set stream = s.CreateStream
    Set body = docMail.CreateMIMEEntity
 ' mise en forme du message en html
     Call stream.WriteText("<Table border = 10><TR><TD bgcolor = #CCEEFF><h1>Hello,</td><TD>" & Cells(18, 2) & "</TD><TD> World!<TD></TR>" & _
                        "<tr><TD>1</td><TD>2</TD><TD>3</td></tr></table>")
 
    Call body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
 
    Call docMail.SEND(False)
    Set docMail = Nothing
    Set body = Nothing
    Set stream = Nothing
 
    MsgBox "Message envoyé"
End Sub