Choisir l'expéditeur lotus dans script VBA

farani1 Messages postés 1 Date d'inscription mardi 22 juin 2010 Statut Membre Dernière intervention 16 février 2011 - 16 févr. 2011 à 14:24
DUX76 Messages postés 22 Date d'inscription mercredi 5 novembre 2003 Statut Membre Dernière intervention 7 mars 2011 - 7 mars 2011 à 15:51
Bonjour à Tous,

Voici mon environnement. Sur un Lotus 6.5 j'ai ma boite perso (farani1@societe.com), et la boite du groupe auquel j'appartiens (groupe3@societe.com). J'ai full accès aux deux boites.
Grâce a tout vos postes (grand merci) j'ai réussi à développer un formulaire Excel qui, une fois complété, doit s'envoyer par mail à un destinataire.
Je souhaite que :
1 - L'entête du mail chez le destinataire soit :
GROUPE3
Envoyé par : farani1
Veuillez répondre à GROUPE3
Pour : DESTINATAIRE

2 ? que dans le dossier « envoyés » de la boite du groupe3 on voit le mail avec l'entête suivante :
GROUPE3
Veuillez répondre à GROUPE3
Envoyé par DESTINATAIRE <<<<<<<<< le sujet de mon problème.
Pour : DESTINATAIRE
Merci pour votre aide.


Voici le code :
'===========================================================
'Pour fonctionner cette procédure a besoin des réferences :
'   -Visual Basic for applications
'   -Microsoft excel Objet Library
'   -Ole Automation
'   -Microsoft office object library
'   -Microsoft forms object library
'   -Lotus domino object
'   -Lotus notes automation class
'   -Microsoft activex data object library
'===========================================================
Private Sub CommandButton1_Click()
    Dim fichier_xls As String           	 ' nom du fichier xls
    Dim code_siege As String              ? code siège de l'agence
    Dim libelle_agence As String          ' libelle de l'agence
    Dim repertoire As String              ' répertoire de sauvegarde
    Dim groupe As String                  ' nom du groupe destinataire
    Dim recipient As String               ' The Recipient string (or you could use the list)
    Dim sujet As String                     ' sujet du mail
    '---------------------------
    'Renseignement des variables
    '---------------------------
    groupe = Sheets("formulaire").Range("C16").Value    ' nom du groupe destinataire
    recipient = Sheets("formulaire").Range("B17").Value ' mail du destinataire du message
    code_siege = Sheets("formulaire").Range("E10")
    libelle_agence = Sheets("formulaire").Range("B10")
    repertoire = "T:\Public"
    fichier_xls = repertoire & code_siege & "_" & Year(Now) & Month(Now) & Day(Now) & "_" & Hour(Now) & Minute(Now) & Second(Now) & "_" & libelle_agence & ".xls" ' nom du fichier xls et son chemin
    sujet = "Message Incident " & "groupe"              ' sujet du mail
    '-----------------------------------
    'sauvegarde de la feuille xls
    '-----------------------------------
    ActiveWorkbook.Worksheets.Add.Name = "Dossier"      'ajout d'une feuille de travail
    Sheets("formulaire").Select                         'selection de la feuille formulaire
    Range("A1:E58").Select                              'choix de la selection à copier
    Selection.Copy                                      'copie de la selection
    'préparation de la feuille a sauvegarder
    Sheets("Dossier").Select                            'selection de la feuille de travail
    ActiveSheet.Paste                                   'on colle la selection dans Dossier
    Sheets("Dossier").Copy                              'feuille à sauvegarder
    Sheets("Dossier").Columns("A:E").EntireColumn.AutoFit  'on regle la largeur des colonne
    Sheets("Dossier").Range("A1").Select                   'on active la prochaine cellule a saisir
    'sauvegarde de la feuille
    Application.DisplayAlerts = False                   'on ne veut pas de message de confirmation
    ActiveWorkbook.SaveAs fichier_xls                   'sauvegarde du formulaire
    ActiveWindow.Close                                  'on ferme le fichier que l'on vient de sauver
    Worksheets("Dossier").Delete                        'suppression de la feuille de travail
    Application.DisplayAlerts = True                    'on remet les messages de confirmation
    '----------------
    'Envoi du message
    '----------------
    If envoi(fichier_xls, sujet, recipient) Then
    MsgBox "Mail envoyé avec fichier :" & Chr(13) & Chr(10) & fichier_xls, vbOKOnly + vbInformation, "Information"
    End If
    'préparation pour la nouvelle saisie
    ' on vide les cellules
    Sheets("formulaire").Range( _
        "E1,B7:E7,B8:E8,B9:E9,B10:C10,E10,E11,B11:C11,B14:E14,B15:E15,B16:E16,B19,D19:E19,A21:E28" _
        ).Select
    Range("A21").Activate
    Selection.ClearContents
    Sheets("formulaire").Range("B7").Select             'on active la prochaine cellule a saisir

End Sub


Function envoi(img As String, subject As String, recipient As String) As Boolean
    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 As String    'The path to the attachemnt string
    Dim Recip(10) As Variant    'The Recipient list
    Dim BodyText As String      'The body text
    Dim SaveIt As Boolean       'Save to sent mail
    Dim WasOpen As Integer      'Checking to see if the Mail DB was already
                                'open to determine if session should be
                                'closed (0) or left alone (1)
    Dim ClipBoard As DataObject 'Data object for getting text from clipboard
    Dim t As String
    Dim sfrom As String
        
    '----------------------------------
    ' préparation de lotus pour le mail
    '----------------------------------
    Set Session = CreateObject("Notes.NotesSession") ' ouvre une session notes
    SaveIt = True                                    ' sauvegarde le mail dans le folder "envoyé"
    UserName = Session.UserName                      ' récupère le username de la session
    sfrom = "GROUPE3"
    '-------------------------------------------------------------------------------------------
    'MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 'nom de la messagerie par défaut
    'Set Maildb = Session.GETDATABASE("", MailDbName) ' selectionne la boite de messagerie par defaut
    '-------------------------------------------------------------------------------------------
    ' on ne veut pas envoyer le message de la boite de l'utlisateur mais de la boite
    ' GROUPE3
    
    Set Maildb = Session.GETDATABASE("/SERVEURS/MAIL", "mail\Mail3\groupe3.nsf") ' selectionne la boite de messagerie
     
   
    If Maildb.IsOpen = True Then                     ' verification si lotus est deja lancé
         WasOpen = 1                                 ' Already open for mail
     Else
         WasOpen = 0                                 ' Lotus n'est pas ouvert
         Maildb.OPENMAIL                             ' This will prompt you for password
     End If
    Set MailDoc = Maildb.CREATEDOCUMENT              ' création du document
    MailDoc.Form = "Memo"                            ' selectionne le type de document
    MailDoc.subject = subject
    MailDoc.Principal = sfrom
    MailDoc.ReplyTo = sfrom
    MailDoc.Sendto = recipient                       ' Or use Racip(10) for multiple
    MailDoc.Body = "Bonjour, merci de trouver ci-joint un incident urgent pour votre groupe."
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    Attachment = img
    If Attachment <> "" Then
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
    End If
    MailDoc.PostedDate = Now()                       ' Gets the mail to appear in the sent items folder
    MailDoc.Send 0, recipient
    envoi = True
ExitProc:
    Application.ScreenUpdating = True
    '---------------
    'Clean Up'
    '---------------
    Range("A1").Select
    Application.CutCopyMode = False
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set EmbedObj = Nothing
    If WasOpen = 1 Then
        Set Session = Nothing
    ElseIf WasOpen = 0 Then
        Session.Close
        Set Session = Nothing
    End If
End Function

1 réponse

DUX76 Messages postés 22 Date d'inscription mercredi 5 novembre 2003 Statut Membre Dernière intervention 7 mars 2011
7 mars 2011 à 15:51
Bonjour,
J'ai exactement la meme problematique, comment modifier la boite de l'expediteur ...
as tu eu des reponses ?


Dux
0