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
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