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
'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
Par avance je vous remercie de votre aide
si possible détailler vos soluces qui je puisse les assimiler
Didier