Envoi de la feuille active Excel via lotus

dps89

Nouveau membre
Bonjour,

J’ai récupérer une macro sur internet que j'ai tenté d'adapter à mes besoins mais je n'ai pas suffisamment de connaissance en programmation pour m'en sortir.
en premier j'ai créé un bouton (userform) pour envoyer le document en automatique, j'ai attribué à ce bouton une macro qui s'ouvre sur une boite de dial avec 2 actions possibles.
1er action: fichier ok = envoi du mail
2eme action : non/ annuler = annulation de la macro
J’ai 2 soucis:

Le 1er : je n'arrive pas (malgré plusieurs essais) à envoyer uniquement la feuille active du dossier Excel

le 2eme: lors de la réception du courriel le bouton d'envoi automatique reste apparent et actif sur le fichier (je souhaiterai le supprimer pour éviter les problèmes)

voici la macro


[cpp][/cpp]
'Private Sub CommandButton1_Click()
Private Sub UserForm_Activate()


'sub envoi_automatique_mail()
'

'
Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
' Variable TEXTE
Dim ntsServer As String
Dim ntsMailFile As String
'
Dim EMailSendTo As String
Dim EMailCopyTo As String
Dim EMailSubject As String
Dim MailPJ As String
Dim LotusSRV As String
Dim WbkName As String
'Dim feuille_semaine As String
'
On Error GoTo err_SendNotesMsg
' Initialisation des variables
EMailSendTo = "adresse mail@web.com"
EMailCopyTo = " en copie"
EMailSubject = "sujet du mail"
'
' Créer une nouvelles session Notes
Set oSess = CreateObject("Notes.NotesSession")
'
'Récupérer le nom du serveur
ntsServer = oSess.GetEnvironmentString("serveur de votre lotus", True)
'Acquière le nom du fichier mailfile de l'utilisateur courant dans Notes.ini
ntsMailFile = oSess.GetEnvironmentString("MailFile", True) 'remplacé MailFile
Set oDB = oSess.GetDatabase(ntsServer, ntsMailFile)
Set oDoc = oDB.CreateDocument
' Définit les éléments à rajouter au message
Set oItem = oDoc.createRichTextItem("BODY")
'
oDoc.Form = "Memo"
' Préparer les destinataires
oDoc.Sendto = EMailSendTo
If Not IsMissing(EMailCopyTo) Then
oDoc.Copyto = EMailCopyTo
End If
'
' Préparer le sujet du message
If Not IsMissing(EMailSubject) Then
If EMailSubject <> "" Then oDoc.Subject = EMailSubject
End If
oDoc.FROM = oSess.CommonUserName
oDoc.PostedDate = Date
' Pour avoir un accusé de réception
' oDoc.ReturnReceipt = "1"
'
' Préparer les texte
'
With oItem
.appendtext "Bonjour,"
.addnewline 2
.appendtext "texte..."
.addnewline 2
.appendtext "Cet e-mail a été généré par un processus automatique."
.addnewline 2
'
End With
' Créer la pièce jointe
' Ca peut être le classeur
WbkName = ThisWorkbook.FullName
'Attachement du classeur au mail
Call oItem.embedObject(1454, "", WbkName, "")
'Fll_S12_2011.Select
'feuille_semaine = Fll_S12_2011
' Attachement du classeur au mail
'Call oItem.embedObject(1454, "", feuille_semaine, "")
'Call oItem.embedObject(1454, "", Fll_S12_2011, "")


' Message de salutation
oItem.addnewline 1
oItem.appendtext "message de salutation"
oItem.addnewline 2
oItem.appendtext "signature"

' Envoyer le message
oDoc.send False
'
MsgBox "Le message a été envoyé", vbInformation, "MESSAGE LOTUS ..."
'
exit_SendNotesMsg:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing
Exit Sub
'
err_SendNotesMsg:
If Err.Number = 7225 Then
MsgBox "Impossible d'attacher le fichier, vérifier le chemin!", vbCritical
Else
MsgBox "[" & Err.Number & "]: " & Err.Description
End If
'
MsgBox "Message non envoyé suite erreur!", vbCritical
Resume exit_SendNotesMsg
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub
[cpp][/cpp]
Par avance je vous remercie de votre aide
si possible détailler vos soluces qui je puisse les assimiler

Didier
 

zeb

Modérateur
Bonjour, et bienvenue.

Merci de lire le règlement et de le respecter, notamment ce qui concerne la présentation du code qui doit se faire grâce la la balise
Code:
. Tout y est expliqué, même l'art de te corriger.
[:zeb:6]

A te lire.
 

dps89

Nouveau membre
bonjour,

j'ai tenter la correction
pas sur du résultat

cordialement
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 052
Membres
1 586 282
Dernier membre
Yannick3553
Partager cette page
Haut