commandbutton pour envoyer userform sur outlook ?

yoyo77

XLDnaute Occasionnel
Bonjour à tous :D,

Je viens vers vous car j'ai un petit problème qui concerne une macro pour envoi de MAIL

En faite j'aimerais avoir un bouton sur l'userform3 qui permettra l'envoi par mail via Outlook,

(Pour lancer l'userform3 il faut en Feuil1 double cliquer sur un N° de la colonne "C")

J'ai cherché et je ne vois pas comment faire :(

SVP auriez-vous une solution pour moi :confused:

Merci :cool:
 

Pièces jointes

  • YOYO77 test mail.zip
    106.7 KB · Affichages: 66

yoyo77

XLDnaute Occasionnel
Re : commandbutton pour envoyer userform sur outlook ?

Bonjour Le Forum :), Bonjour Martial :D,

Ca fonctionne nickel mais quand je vœux répéter la macro de Yaloo dans un autre userform ca plante
je colle ci-dessous la macro de Martial qui fonctionne bien pour l'userform3 et en dessous la même macro adaptée pour l'userform9 qui plante toujours au même endroit :

Private Sub CommandButton2_Click()
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
Dim Ws As Worksheet, F4
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$, i&

F4 = Array("C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C19", "C20")
For i = 1 To 19
Feuil18.Range(F4(i)) = Controls("TextBox" & i)
Next

Feuil18.Copy
ActiveWorkbook.SaveAs "D:\Anomalie.xlsx"
ActiveWorkbook.Close
'Envoi Mail
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

Debut = "Messieurs, <BR><BR><BR>Veuillez trouver en pièce jointe un rapport d'anomalie,<BR><BR>"
Fin = "<BR> <BR> <BR> <BR>Cordialement. <BR> <BR> <BR>Service de sécurité et de protection incendie <BR> <BR>ASC <BR> <BR>(Message automatique)"
On Error Resume Next
With OutMail
.To = "T@ing.com"

.CC = "ch@rite.fr;" & _
"g@live.fr"
.Subject = "Rapport d'anomalie N°" & TextBox4 & " Daté du " & TextBox1
.Attachments.Add "D:\Anomalie.xlsx"
.HTMLBody = Debut & Fin

.Display 'pour voir
'.Send 'pour envoyer directement
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
'Suppression du fichier image JPG
Kill "D:\Anomalie.xlsx"
'Suppression des données en Feuil4
For i = 1 To 19
Feuil18.Range(F4(i)) = ""
Next
Unload Me
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
End Sub

Private Sub CommandButton3_Click()
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
Dim Ws As Worksheet, F4
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$, i&

F4 = Array("C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C19", "C20")
For i = 1 To 19
Feuil18.Range(F4(i)) = Controls("TextBox" & i)
Next

Feuil18.Copy
ActiveWorkbook.SaveAs "D:\Anomalie.xlsx"
ActiveWorkbook.Close
'Envoi Mail
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

Debut = "Madame lidieu, <BR><BR><BR>Veuillez trouver en pièce jointe un rapport d'anomalie,<BR><BR>"
Fin = "<BR> <BR> <BR> <BR>Cordialement. <BR> <BR> <BR>Service de sécurité et de protection incendie <BR> <BR>ASC <BR> <BR>(Message automatique)"
On Error Resume Next
With OutMail
.To = "lidieu@ra.com"

.CC = "h@rite.fr;" & _
"g@live.fr"
.Subject = "Rapport d'anomalie N°" & TextBox4 & " Daté du " & TextBox1
.Attachments.Add "D:\Anomalie.xlsx"
.HTMLBody = Debut & Fin

.Display 'pour voir
'.Send 'pour envoyer directement
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
'Suppression du fichier image JPG
Kill "D:\Anomalie.xlsx"
'Suppression des données en Feuil4
For i = 1 To 19
Feuil18.Range(F4(i)) = ""
Next
Unload Me
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
End Sub



Macro sur userform 9 qui plante:


Private Sub CommandButton2_Click()
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
Dim Ws As Worksheet, F19
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$, i&

F19 = Array("C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C19", "C20", "C21")
For i = 1 To 20
Feuil19.Range(F19(i)) = Controls("TextBox" & i) = Erreur l'indice n'appartient pas à la sélection
Next
Feuil19.Copy
ActiveWorkbook.SaveAs "D:\IPS.xlsx"
ActiveWorkbook.Close
'Envoi Mail
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

Debut = "Messieurs, <BR><BR><BR>Veuillez trouver en pièce jointe un rapport d'anomalie,<BR><BR>"
Fin = "<BR> <BR> <BR> <BR>Cordialement. <BR> <BR> <BR>Service de sécurité et de protection incendie <BR> <BR>ASC <BR> <BR>(Message automatique)"
On Error Resume Next
With OutMail
.To = "MT@ing.com"

.CC = "h@rite.fr;" & _
"g@live.fr"
.Subject = "Facteur IPS Daté du " & TextBox1
.Attachments.Add "D:\IPS.xlsx"
.HTMLBody = Debut & Fin

.Display 'pour voir
'.Send 'pour envoyer directement
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
'Suppression du fichier image JPG
Kill "C:\IPS.xlsx"
'Suppression des données en Feuil19
For i = 1 To 20
Feuil19.Range(F19(i)) = ""
Next
Unload Me
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
End Sub

Private Sub CommandButton3_Click()
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
Dim Ws As Worksheet, F19
Dim OutApp As Object, OutMail As Object
Dim Debut$, Fin$, i&

F19 = Array("C2", "C3", "C4", "C5", "C6", "C7", "C8", "C9", "C10", "C11", "C12", "C13", "C14", "C15", "C16", "C17", "C18", "C19", "C20", "C21")
For i = 1 To 20
Feuil19.Range(F19(i)) = Controls("TextBox" & i)
Next

Feuil19.Copy
ActiveWorkbook.SaveAs "D:\IPS_rapport.xlsx"
ActiveWorkbook.Close
'Envoi Mail
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

Debut = "Madame lidieu, <BR><BR><BR>Veuillez trouver en pièce jointe un rapport d'anomalie,<BR><BR>"
Fin = "<BR> <BR> <BR> <BR>Cordialement. <BR> <BR> <BR>Service de sécurité et de protection incendie <BR> <BR>ASC <BR> <BR>(Message automatique)"
On Error Resume Next
With OutMail
.To = "lidieu@ra.com"

.CC = "h@rite.fr;" & _
"g@live.fr"
.Subject = "IPS N°" & TextBox4 & " Daté du " & TextBox1
.Attachments.Add "D:\IPS.xlsx"
.HTMLBody = Debut & Fin

.Display 'pour voir
'.Send 'pour envoyer directement
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
'Suppression du fichier image JPG
Kill "D:\IPS_rapport.xlsx"
'Suppression des données en Feuil19
For i = 1 To 20
Feuil19.Range(F19(i)) = ""
Next
Unload Me
Application.ScreenUpdating = 0: Application.DisplayAlerts = 0
End Sub


Quelqu'un à une idée pour ca plante ?

Merci
 
Dernière édition:

Yaloo

XLDnaute Barbatruc
Re : commandbutton pour envoyer userform sur outlook ?

Bonsoir yoyo,

Comme ça, sans fichier, c'est difficile, tu as l'erreur dès le début de la boucle, ou en cours de boucle.

Si en cours de boucle, as-tu bien le même nombre de TextBox et "Cellule" ? Fait des essais en pas à pas (touche F8).

Sachant que si ton array sont des cellules qui se suivent, il n'y a peut-être pas besoin de passer par un array.

A+

Martial
 

Discussions similaires

Réponses
1
Affichages
287
Compte Supprimé 979
C

Statistiques des forums

Discussions
312 836
Messages
2 092 630
Membres
105 474
dernier inscrit
ramzi slama