PureBoard

Code: Alles auswählen

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/Lotus_SmartSuite/Lotus_Notes/Q_20248333.html

Hope someone can give me some direction on this.  I have the task of programming the sending of automated e-mail from A97 in a Lotus Notes/Domino enviroment.  I started off using the the following code:

Public Sub SendNotesMail(Subject As String, Attachment As String, BodyText As String, SendTo As String, Optional CC As String = "", Optional BCC As String = "", Optional SaveIt As Boolean = False)
   
   'Set up the objects required for Automation into lotus notes
   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 intAttach As Integer
   Dim intAttachments As Integer
   Dim strAttachmentName As String
   
   'Start a session to notes
   Set Session = CreateObject("Notes.NotesSession")
   
   'Get the sessions username and then calculate the mail file name
   'You may or may not need this as for MailDBname with some systems you
   'can pass an empty string
   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
   With MailDoc
    .Form = "Memo"
    .SendTo = SendTo
    .CopyTo = CC
    .BlindCopyTo = BCC
    .Subject = Subject
    .Body = BodyText
    .SAVEMESSAGEONSEND = SaveIt
    
    'Set up the embedded object and attachment and attach it
    intAttachments = dhCountTokens(Attachment, ",")
    For intAttach = 1 To intAttachments
      strAttachmentName = dhExtractString(Attachment, intAttach, ",")
      Set AttachME = .CREATERICHTEXTITEM("Attachment" & CStr(intAttach))
      Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", strAttachmentName, "Attachment" & CStr(intAttach))
      .CREATERICHTEXTITEM ("Attachment" & CStr(intAttach))
    Next intAttach
    'Send the document
    .PostedDate = Now() 'Gets the mail to appear in the sent items folder
    .send False
   End With
   
   'Clean Up
   Set Maildb = Nothing
   Set MailDoc = Nothing
   Set AttachME = Nothing
   Set Session = Nothing
   Set EmbedObj = Nothing

End Sub



 But this had the main dis-advantage of prompting for a password (hence no automation and leaving the password blank is not really an option.  After reading some docs, I discovered that it was impossible to send the password with the OLE automation method above.  It also had the drawback of requiring the notes client to be installed and firing up the client in memory everytime a message was sent.

  After some more leg work, I discovered the Lotus Domino Objects COM interface where I could talk directly to the Domino server.  I've managed to get to the point where I can create a document (see code below) in the users mail database, but it appears I need to format the document as a "mail document" (my term), which is something that the notes client normally does.

  The COM object doesn't support the .Form, .SendTo, .Body, etc properties, so it appears that I need to format the document myself via internal fields.  However the COM doc's are poor and I can't find any examples of how I might go about filling this document with fields.

 Can anyone point me to doc's on documents or explain how they are internally formatted?  The e-mails I send will have attachements.

Jim.

Code: Alles auswählen

Private Sub UseLotus() 

    Dim Session As Object 
    Dim db As Object 
    Dim doc As Object 
    Dim rtitem As Object 
    Dim object As Object 
    Dim fs As Object 
    Dim Principaux(2) As String 
    Dim Copies(3) As String 
    Dim dir As Object 
    Dim inti As Integer 
    Dim passwd As String 
      
    On Error GoTo TraiteErreur 
     
    'Demande le password Lotus(Dans le cas ou la session necessite un passwd) 
    passwd = InputBox("Entrer votre password Lotus:", "Password") 
     
    ' Création de la session Notes 
    Set Session = CreateObject("Lotus.NOTESSESSION") 
     
    'Ouverture d'une session NOTES 
    Call Session.Initialize(passwd)'si pas de passwd pas de parametre pour initialize 

    Set dir = Session.GETDBDIRECTORY("FranceServer1/DCI/BME/Omnia Group") 
    Set db = dir.OpenMailDatabase 
     
    ' Création d'un document 
    Set doc = db.CREATEDOCUMENT 

    'affectation du type mail 
    Call doc.APPENDITEMVALUE("Form", "Memo") 

    Call doc.APPENDITEMVALUE("Sendto", "destinataire@vba.com") 
    Call doc.APPENDITEMVALUE("subject", "sujet") 
    doc.SAVEMESSAGEONSEND = saveit 'sauvegarde du mail à l envoi 
     
    Set rtitem = doc.createRichTextItem("Body") 
     
     
    Dim nom As string 
    nom = ThisWorkbook.FullName 
    'Attachement du classeur au mail 
    Set object = rtitem.embedObject(1454, "", nom,"") 
     
    Call doc.Send(True) 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Exit Sub 

TraiteErreur: 
    MsgBox "Erreur Critique durant l envoi .", vbCritical, "Error" 
    Set object = Nothing 
    Set rtitem = Nothing 
    Set doc = Nothing 
    Set db = Nothing 
    Set Session = Nothing 
    Set fs = Nothing 

End Sub 

Code: Alles auswählen

Comment envoyer un mail avec Lotus Notes ?		

'Envoi d'un mail avec Lotus Notes
'Subject : sujet du mail
'Attachment : nom d'une pièce jointe
'Recipient : adresse e-mail du destinataire principal
'ccRecipient : destinataire en copie
'bccRecipient : destinataire en copie invisible
'BodyText : corps du mail
'SaveIt : mettre à True pour que le mail soit sauvegardé
'Password : mot de passe

Public Sub SendNotesMail(ByVal Subject As String, ByVal Attachment As String, _
                         ByVal Recipient As String, ByVal ccRecipient As String, _
                         ByVal bccRecipient As String, ByVal BodyText As String, _
                         ByVal SaveIt As Boolean, ByVal Password As String)
                         
    Dim Maildb As Object      'La base des mails
    Dim UserName As String    'Le nom d'utilisateur
    Dim MailDbName As String  'Le nom de la base des mails
    Dim MailDoc As Object     'Le mail
    Dim AttachME As Object    'L'objet pièce jointe en RTF
    Dim Session As Object     'La session Notes
    Dim EmbedObj As Object    'L'objet incorporé
   
    'Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
   
    '*** Cette ligne est réservée aux versions 5.x et supérieur : ***
    Session.Initialize (Password)
   
    '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.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.CopyTo = ccRecipient
    MailDoc.BlindCopyTo = bccRecipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
   
    'Prend en compte les pièces jointes
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
   
    'Envoie le mail
    MailDoc.PostedDate = Now()
    MailDoc.SEND 0, Recipient
   
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub
Il est aussi possible d'indiquer à Lotus Notes plusieurs destinataires en affectant un tableau de type Variant à la propriété sendto :

Dim recip(25) as Variant

recip(0) = "emailaddress1"
recip(1) = "emailaddress2"
maildoc.sendto = recip

Code: Alles auswählen

Option Explicit 
'---------- API ----------- 
'pour faire passer au premier plan 
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long 
'pour ouvrir la fenetre 
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 
'pour verifier si la Lotus est ouvert 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 
     
Dim sSrvr As String 'the mail server for the current user 
Dim MailDbName As String 'THe current users notes mail database name 
Dim UserName As String 'The current users notes name 

Dim retval As Variant 'Holds return value for functions handle 

'---------------- fonction ouverture de session Notes ----------- 
Function CreateNotesSession() As Boolean 
    Const notesclass$ = "NOTES" 
    Const SW_SHOWMAXIMIZED = 3 'plein ecran 
    Const SW_SHOWMMINIZED = 2 'reduire 
    Const SW_SHOWWINDOW = 1 'fenetre 
    Const SW_SHOW = 5 
     
    Dim Lotus_Session As Object 
    Dim rc& 
    Dim lotusWindow& 
     
    lotusWindow = FindWindow(notesclass, vbNullString) 

    Set Lotus_Session = CreateObject("Notes.NotesSession") 
    sSrvr = Lotus_Session.GETENVIRONMENTSTRING("MailServer", True) 
    MailDbName = Lotus_Session.GETENVIRONMENTSTRING("MailFile", True) 
    UserName = Lotus_Session.UserName 
     
    DoEvents 
    'Ouverture de Lotus Notes 
    retval = Shell("C:\APPLI\Notes5\notes.exe =h:\notes\notes.ini", vbMaximizedFocus) 
     
    'verifier que Lotus est bien ouvert (recupere le handle) 
    lotusWindow = FindWindow(notesclass, vbNullString) 
    If lotusWindow <> 0 Then 
        rc = ShowWindow(lotusWindow, SW_SHOW) 
        rc = SetForegroundWindow(lotusWindow) 
        CreateNotesSession = True 
    Else 
         CreateNotesSession = False 
    End If 
End Function 
Sub CreateMailandAttachFileAdr(Optional IsSubject As String = "", Optional SendToAdr As String, Optional CCToAdr As String, Optional BCCToAdr As String = "", Optional Attach1 As String = "", Optional Attach2 As String = "", Optional body As String = "") 
Const EMBED_ATTACHMENT As Integer = 1454 
Const EMBED_OBJECT As Integer = 1453 
Const EMBED_OBJECTLINK As Integer = 1452 

Dim s As Object ' use back end classes to obtain mail database name 
Dim db As Object ' 
Dim doc As Object ' front end document 
Dim beDoc As Object ' back end document 
Dim workspace As Object ' use front end classes to display to user 
Dim bodypart As Object ' 
Dim bodyAtt As Object ' 
Dim lbsession As Boolean 

lbsession = CreateNotesSession 

If lbsession Then 
    'cree la session Lotus Notes 
    Set s = CreateObject("Notes.Notessession") 
    'se connecte a sa database 
    Set db = s.getDatabase(sSrvr, MailDbName) 
    If db.ISOPEN = True Then 
        'database deja ouvert 
    Else 
        Call db.Openmail 
    End If 
    'cree un document memo 
    Set beDoc = db.CreateDocument 
    beDoc.Form = "Memo" 
     
    'construction du mail 
    Set bodypart = beDoc.CREATERICHTEXTITEM("Body") 
    'beDoc.From = "Moi" 'inutile 
    beDoc.SendTo = SendToAdr 
    beDoc.CopyTo = CCToAdr 
    beDoc.BlindCopyTo = BCCToAdr 
    beDoc.Subject = IsSubject 
    '----------------------------------------- 
    'Remarque si destinataire multiple il suffie de mettre un tableau d'e-mail dans SendTo (CopyTo,BlindCopyTo) 
    'exemple : 
    'Dim recip(25) as variant 
    'recip(0) = "emailaddress1" 
    'recip(1) = "emailaddress2" e.t.c 
    'beDoc.sendto = recip 
    '---------------------------------------- 
    ' documents joint 1 
    If Len(Attach1) > 0 Then 
        If Len(Dir(Attach1)) > 0 Then 
           Set bodyAtt = bodypart.EmbedObject(EMBED_ATTACHMENT, "", Attach1, Dir(Attach1)) 
        End If 
    End If 

    ' documents joint 2 
    If Len(Attach2) > 0 Then 
        If Len(Dir(Attach2)) > 0 Then 
            Call bodyAtt.EmbedObject(EMBED_ATTACHMENT, "", Attach2, Dir(Attach2)) 
        End If 
    End If 
         
    'Affichage du mail dans Lotus Notes 
    Set workspace = CreateObject("Notes.NotesUIWorkspace") 
    Call workspace.EditDocument(True, beDoc).FieldSetText("Body", body) 

    Set s = Nothing 
Else 
    MsgBox "Votre Lotus Notes est fermé !" 
End If 
End Sub 
Private Sub envoyer_Click() 
    CreateMailandAttachFileAdr Msujet.Text, Mto.Text, Mcc.Text, Mbcc.Text, MdocJoint1.Text, MdocJoint2.Text, Mbody.Text 
End Sub 

Code: Alles auswählen

Dim Lotus_Session as Object
Dim UserName As String
Set Lotus_Session = CreateObject("Notes.NotesSession")
UserName = Lotus_Session.UserName
[...]
Set Lotus_Session = Nothing

Code: Alles auswählen

Define Lotus_Session.COMateObject
Define UserName.s
Lotus_Session = COMate_CreateObject("Notes.NotesSession")
UserName = Lotus_Session\GetStringProperty("UserName")
[...]
Lotus_Session\Release()