Amélioration Code Excel vers Lotus Notes 6.5

**chyanon** · 22/03/2011, 21h58

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 :

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
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

**pgz** · 23/03/2011, 00h18

Bonsoir.

Pour le début du code, jusqu'à la création du mail et en late biding, j'utilise souvent :

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
    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
 
    'Init
    On Error Resume Next
        Session.Initialize
        Err.Clear
   On Error GoTo ErrEnvoi
 
    'Récupère le nom d'utilisateur et crée le nom de la base des mails
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
 
    'Ouvre la base des mails
    Set Maildb = Session.GETDATABASE("", MailDbName)
 
    If Not Maildb.IsOpen Then Maildb.OpenMail
 
    'Paramètre le mail à envoyer
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc. ...

Si l'opérateur n'a pas ouvert Lotus, on part sur ErrEnvoi. Si c'est ouvert, on ne lui demande pas le MDP.

Cordialement,

PGZ

PGZ

**chyanon** · 23/03/2011, 17h52

Merci PGZ,

J'ai essayé de m'inspirer de ton code mais sans succès(pour l'instant).
J'ai un défaut Objet.
Y a t'il une référence particulière à cocher.

**pgz** · 24/03/2011, 19h20

Bonsoir.

Tu as une erreur sur quelle ligne?

PGZ

**chyanon** · 25/03/2011, 19h09

Bonjour et encore merci à toi PGZ

J'ai trouvé une partie de mon bonheur avec ce 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
56
57
58
Sub SendNotesMail()
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim ATTACHMENT
 
 
    ATTACHMENT = UserForm1.TextBox5.Value
    Sheets("ENREGISTREMENTS").Select
    NUM = Application.WorksheetFunction.Max(Range(Cells(1, 1), Cells(65000, 1)))
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "DEMANDES COURANTES ELEC      N° " & NUM & "     " & Sheets("SAISIE").Range("E8") & ":   " & Sheets("SAISIE").Range("F8") & "        " & Sheets("SAISIE").Range("E9") & ":   " & Sheets("SAISIE").Range("F9") & "        " & Sheets("SAISIE").Range("E10") & ":   " & Sheets("SAISIE").Range("F10")
    MailDoc.body = UserForm1.ComboBox1.Value & " à fait une demande de type " & UserForm1.ComboBox2.Value & " sur la commande (BELEM et/ou CLIP): " & UserForm1.TextBox3.Value & " / " & UserForm1.TextBox4.Value & Chr(13) & Chr(13) & "Le libellé :" & UserForm1.TextBox2.Value
    MailDoc.SaveMessageOnSend = saveit
 
    'PJ
    If ATTACHMENT <> "" Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EmbedObject(1454, "", ATTACHMENT, "Attachment")
    End If
 
 
    'Send the document
    MailDoc.PostedDate = Now()
    MailDoc.Send 0, "ffffffff@xxxxxx.com"
 
 
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Ce code me permet d'envoyer mon mail sans mot de passe lorsque lotus note est ouvert .Comme lotus notes est quasi constamment ouvert sur nos postes, il n'y a pas de problème si un opérateur doit taper son mot de passe de temps en temps(point 1 résolu).

Pour le point 2:
Mon fichier est sur un disque : P:\eeeeee\dddd\GGG.xls
Je veut envoyer en PJ le raccourci de ce fichier et non pas le fichier.
Quand je le fais manuellement je crée un raccourci dans le classeur et j'envoie ce raccourci en PJ.
Comment le faire en vba?

**pgz** · 25/03/2011, 19h41

Bonjour.

Et oui, pourquoi faire simple?

De mémoire : la bibli IWSH (Windows script host object model) permet de manipuler des raccourcis (Shorcut). Tu peux fouiner dans cette direction.

COrdialement,

PGZ

Amélioration Code Excel vers Lotus Notes 6.5

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager