Envoi mail automatique

salut tous les mondes

je suis un débutant dans ce langage et j'ai besoin de vos aides pour atteindre mon objectif

bon

j'ai créé un gestion de maintenance sur Excel 2007, gestion de Taches avec dates de début et dates de fin. Ces taches, je voudrais quelles me soient envoyées

certains jours avant la date limite de réalisation. j'ai donc créer une fonction dans la colonne E qui m'affiche « attention ,date dépassée » (comme Alerte) lorsqu'il me reste des jours avant la date finale de réalisation.

Je souhaite que lorsque « attention ,date depassée » apparait en cellule E5 à Exxx,(Range) un e_mail me soit envoyé avec dans le corps du mail:

la description de la tache => colonne F (première cellule F7) « feuille de suivi »

remarque que j’ai deux feuille dans ce classeur et le travail de mail dans le feuille de suivi

je sais pas est ce que la declaration de sheet correcte ou ou non

ce code sa marcha pas je sais pas erreur de compilation ou’est le probléme

Private Sub Worksheet_Activate()

Sub activateSheet(sheetname As String)

'activates sheet of specific name

Worksheets("feuille de suivi").Activate

End Sub

Sub Mail_small_Text_Outlook()

'Working in Office 2000-2010

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro

Dim cellule As Range

Dim i As Integer

'ici je repère la dernière ligne vide pour la Collections des données

L = Range("B65536").End(xlUp).Row + 1

'on met la cellule en F5

Set cellule = ActiveWorkbook.Sheets(0).Range("F5")

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

i = 0

'on fait la boucle en imaginant que F5 est toujours remplis

While cellule.Offset(i, 0).Value <> ""

If cellule.Offset(i, 20).Value = "Attention, date dépasée" Then

strbody = "description : " & cellule.Offset(i, 0).Value & vbCrLf

End If

Wend

With OutMail

.To = "mounir_kraim@hotmail.com"

.CC = ""

.BCC = ""

.Subject = "Avertissement sur Tâche"

.Body = strbody

'You can add a file like this

'.Attachments.Add ("C:\test.txt")

.Send 'or use .Display

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Hello

Nombreuses erreurs de recopie !!

Manque ! et un s et pourquoi 20 ?

If cellule.Offset(i, 20).Value = "Attention, date dépassée!"

DesEnd Sub en trop

Des suben trop ......

strbodynon initialisée

C'est de l'à-peu-près ... fais ta mise au point par étape !

merci de me repondre

encore meme avec correction de l'instruction

If cellule.Offset(i, 11).Value = "Attention, date dépassée!" Then

toujours erreur de compilation

l'erreur c'est : seuls des commentaires peuvent apparaitre aprés end sub ,endfunction, ou end property

et comme je vous mentionné je suis un débutant j'ai pas la capacité de ressoudre ce probléme

merci pour votre compréhension

J'ai eu erreurs sur erreurs ... tu t'attaques d"une seul coup à trop gros. Même moi je vais pas par pas.

Essaie d'abord dans un message (MsgBox) de récupérer les informations que tu veux mettre dans un mail.

Ensuite le message est clair (et cela ne sera pas le seul) : la procédure commence par sub et se termine par end sub (et un seul).

salut

j'ai essayé par ce code mais ili m' apparait un message

erreur d'exution 9 " l'indice n'appartient pas à la selection

dans l'instruction suivant:

Set cellule = ActiveWorkbook.Sheets(0).Range("F5")

voila le code que j'ai utlisée

Private Sub Worksheet_Change(ByVal Target As Range)

Dim isect As Range

Set isect = Intersect(Target, [E5])

If isect Is Nothing Then Exit Sub

On Error GoTo fin

Application.EnableEvents = False

'ici MonAction

fin:

Application.EnableEvents = True

End Sub

Sub Mail_small_Text_Outlook()

'Working in Office 2000-2010

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro

Dim cellule As Range

Dim i As Integer

'ici je repère la dernière ligne vide pour la Collections des données

L = Range("E65536").End(xlUp).Row + 1

'on met la cellule en F5

Set cellule = ActiveWorkbook.Sheets(0).Range("F5")

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

i = 0

'on fait la boucle en imaginant que F5 est toujours remplis

While cellule.Offset(i, 0).Value <> ""

If cellule.Offset(i, 11).Value = "Attention, date dépassée!" Then

strbody = "description : " & cellule.Offset(i, 0).Value & vbCrLf

End If

Wend

With OutMail

.To = "mounir_kraim@hotmail.com"

.CC = ""

.BCC = ""

.Subject = "Avertissement sur Tâche"

.Body = strbody

'You can add a file like this

'.Attachments.Add ("C:\test.txt")

.Send 'or use .Display

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

C'est quoi pour toi ActiveWorkbook.Sheets(0). ?

Mats une procédure comme suit

sub test()
msgbox ActiveWorkbook.Sheets(0).Name
end sub

Essaie maintenant sans car c'est la feuille en cours sur laquelle tu t'appuies.

Set cellule = Range("F5")

... on va attendre la prochaine erreur !

MEeci de me repondre

bon j'ai changé l'instruction que tu m'envoyé mais il m'apparait une erreur de compilation "END sub attendu"

sur 'on met la cellule F5

Sub Mail_small_Text_Outlook()

'Working in Office 2000-2010

Dim OutApp As Object

Dim OutMail As Object

Dim strbody As String

Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro

Dim cellule As Range

Dim i As Integer

'ici je repère la dernière ligne vide pour la Collections des données

L = Range("E65536").End(xlUp).Row + 1

'on met la cellule en F5

Sub test()

MsgBox ActiveWorkbook.Sheets(0).Name

Set cellule = Range("F5")

End Sub

merci pour votre propre aide

ing2017 a écrit :

salut

j'ai essayé par ce code mais ili m' apparait un message

erreur d'exution 9 " l'indice n'appartient pas à la selection

dans l'instruction suivant:

Set cellule = ActiveWorkbook.Sheets(0).Range("F5")

Hello,

1- dans tes posts, sélectionne le code et ensuite appuie sur la balise code !

2- En fait Sheets(0) n'existe pas ! je ne sais pas où tu vas chercher tout cela !


ing2017 a écrit :

MEeci de me repondre

bon j'ai changé l'instruction que tu m'envoyé mais il m'apparait une erreur de compilation "END sub attendu"

sur 'on met la cellule F5

Une procédure c'est :

Sub proc1()

End Sub
Sub proc2()

End Sub
Sub proc3()

End Sub

Si tu fais comme ci-dessous, c'est à dire une procédure dans une autre, cela ne fonctionne pas

]Sub proc1()

Sub proc2()
End Sub

End Sub

Pour revenir sur les indices des onglets, tu peux ajouter cette procédure dans module3 par exemple

Sub nomdesonglets()

Dim i As Integer
For i = 1 To Sheets.Count
   MsgBox i & " > " & Sheets(i).Name
Next

End Sub

Ton coeur de procédure ne fonctionne pas, remplace d'abord tout ceci

i = 0

'on fait la boucle en imaginant que F5 est toujours remplis
While cellule.Offset(i, 0).Value <> ""
     If cellule.Offset(i, 20).Value = "Attention, date dépasée" Then
         strbody = "description : " & cellule.Offset(i, 0).Value & vbCrLf

     End If

Wend

par

strbody = "Hello !"

On pourra déjà mettre au point l'envoi des mails.

On passera ensuite à la sélection des données.

Bon, allons y direct à la correction.

Option Explicit
Sub envoi()
Dim strBody, ligne
Dim messagerie As Object
Dim email As Object

    strBody = ""
    For ligne = 5 To Cells(4, "D").End(xlDown).Row
        If Cells(ligne, "E").Value = "Attention, date dépassée!" Then
            strBody = strBody & "description : " & Cells(ligne, "D").Value & vbCrLf
        End If
    Next

    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .To = "mounir_kraim@hotmail.com"
        .Subject = "Avertissement sur Tâche"
        .body = strBody
        .display
    End With
    Set email = Nothing
    Set messagerie = Nothing

End Sub

Essaie de comprendre le code

et complète avec le reste !

salut steelson merci pour votre propre aide maintenant si j'exécute ne me donne rien aucune erreur et aussi l'envoi ça marche pas

et comme je vous mentionné de le début j'ai pas une grande idée sur VBA merci de m'envoyé votre avis

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Set isect = Intersect(Target, [E5])
If isect Is Nothing Then Exit Sub
On Error GoTo fin
Application.EnableEvents = False
'ici MonAction
fin:
Application.EnableEvents = True
End Sub

Sub Mail_small_Text_Outlook()
'Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Dim L As Integer 'Déclaration de variable "L" pour connaitre la Ligne Numéro
Dim cellule As Range
Dim i As Integer
'ici je repère la dernière ligne vide pour la Collections des données
L = Range("E65536").End(xlUp).Row + 1
End Sub
'on met la cellule en F5
Option Explicit
Sub envoi()
Dim strBody, ligne
Dim messagerie As Object
Dim email As Object

    strBody = ""
    For ligne = 5 To Cells(4, "D").End(xlDown).Row
        If Cells(ligne, "E").Value = "Attention, date dépassée!" Then
            strBody = strBody & "description : " & Cells(ligne, "D").Value & vbCrLf
        End If
    Next
 Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .To = "mounir_kraim@hotmail.com"
        .Subject = "Avertissement sur Tâche"
        .body = strBody
        .display
    End With
    Set email = Nothing
    Set messagerie = Nothing

End Sub

salut steelson je vous rappelle que les objects que seront envoyé par mail sont le colonne F chaque fois la colonne E contient "atention ,date depassée" car dans le code que tu m'envoyé je trouve la colonne D or cette colonne n'est pas concerné

OK

Dans la procédure que je t'ai envoyée, remplace

strBody = strBody & "description : " & Cells(ligne, "D").Value & vbCrLf

par

strBody = strBody & "description : " & Cells(ligne, "F").Value & vbCrLf

J'en conclus qu'à part cela, ça fonctionne ? la mail est vient affiché correctement !

Supprime totalement ta procédure qui est simplifiée et remplacée par celle que je t'ai mise dans le fichier "correction" module 1.

Sub Mail_small_Text_Outlook()
....
End Sub

salut steelson j'ai fait comme ça comme tu m'a dit mais meme probleme aucunne erreur et aucune mail envoyée aussi

Option Explicit
Sub Mail_small_Text_Outlook()
Dim strBody, ligne
Dim messagerie As Object
Dim email As Object

    strBody = ""
    For ligne = 5 To Cells(5, "E").End(xlDown).Row
        If Cells(ligne, "E").Value = "Attention, date dépassée!" Then
            strBody = strBody & "description : " & Cells(ligne, "F").Value & vbCrLf
        End If
    Next

    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .To = "mounir_kraim@hotmail.com"
        .Subject = "Avertissement sur Tâche"
        .body = strBody
        .display
    End With
    Set email = Nothing
    Set messagerie = Nothing

End Sub

Remets moi tout le fichier !

et même avec le fichier que j'avais corrigé cela te fais ça ?

Ton bouton envoyer ne pointait sur rien du tout !!

Je n'ai pas réussi à l'enlever, donc j'en ai mis un autre au-dessus

salut steelson alors je vous presente le fichier que tu m'envoyé avec correction

Il faut retirer le petit bouton envoyer, ou le faire pointer vers la macro, je n'ai pas réussi à le faire !

Mais si tu cliques sur le large bouton en arrière plan cela fonctionne !

salut stelson bon le bouton sa sera rien pour le travail moi j'essayé de retier mais ça marche pas

je vais l'envoi automatique sans bouton bon je vais recopier tout le travail dans une autre nouveau ficheir et apr la suite je l'exécute et on va voir se fonctionne ou non car je ne réçoit aucune mail à mon boite jusqu'a maintenant

1mounir-projet.xlsm (15.09 Ko)

salut steelson Merci de me consacrer de ton temps.

bon j'ai repeté le travail dans autre classeur sans bouton d'envoi et j'ai recopie les codes le deux code de clignottement cellule D et l'apparition "attention date depassée " se fonctionne bien reste le code de l'envoi mail ça marche pas malgré comme je te dis pas d'erreur voila le nouveau fichier merci de me suivre

Rechercher des sujets similaires à "envoi mail automatique"