farani1
Messages postés1Date d'inscriptionmardi 22 juin 2010StatutMembreDernière intervention16 février 2011
-
16 févr. 2011 à 14:24
DUX76
Messages postés22Date d'inscriptionmercredi 5 novembre 2003StatutMembreDerniè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
