Envoie Mail automatique Outlook via Excel VBA [Résolu/Fermé]

Signaler
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
-
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
-
Bonjour à tous,

Je souhaiterais automatiser mon fichier excel de relance avec une VBA lié à Outlook.

Pour être précis :

J'ai un fichier excel avec plein de lignes et des informations de la Celulle A à la Cellule K.

Je souhaiterais donc que si la cellule K est vide alors j'envoie un mail de relance automatique avec :

-MonMessage.To = en fonction du nom dans la cellule G alors l'adresse sera liée à ce nom (recherche V?)
-MonMessageSubject = devra être un texte fixe avec en variable la valeur contenu dans la cellule C
-MonMessageBody = qui sera fixe, càd toujours le même

Et une dernière chose qui serait idéal pour ne pas relancer à chaque fois les mêmes, serait qu'une fois le mail envoyé, le texte "RELANCE 1" s'inscrive dans la celulle K.

J'avais trouvé 2 modèles en fouillant sur Internet mais rien que je n'arrive à adapter seul.
Un avec
ActiveCell.MailEnvelope
et un autre avec :
Set MonOutlook = CreateObject("Outlook.Application")
  Set MonMessage = MonOutlook.createitem(0)


Merci d'avance pour votre aide.


17 réponses

Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Rectification apportées pour ton projet:


Sub Testmailauto()
    Dim Trouve As Boolean
    Dim x As Integer
     Trouve = False
    x = 2
    Do
        'Boucle tant que le compteur x est inférieur à 100
        Do While x < 100
            'Incrémente le compteur.
            x = x + 1
            'Vérifie le contenu de la cellule.
            If Cells(x, 11) = "" Then
                'Attribue la valeur Vrai si la cellule est trouvée.
                Trouve = True
                'Anticipe la sortie de la boucle.
                Exit Do
            End If
        Loop
    'Quitte la boucle si la variable à la valeur True.
    Loop Until Trouve = True Or x = 100

    'Affiche un message en fonction du résultat de la recherche.
   If Trouve = True Then
    Range("K" & x).Value = "RELANCE 1"
    envoimail1
    Else
   MsgBox "Relance déjà effectuée!"
   End If
End Sub


1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 62333 internautes nous ont dit merci ce mois-ci

Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Bonjour à tous,

Peut être que ce que je cherche à faire est impossible non?

Merci d'avance pour votre réponse.
Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Bonjour,

Tout d'abord ce n'est pas la cellule k, c'est la colonne K. Pour la cellule c'est K1 par exemple.

Voici un code a toi de l'adapter:

Private Sub CommandButton1_Click()
If Range("K1").Value = "" Then
envoimail
Range("K1").Value = "RELANCE 1"
Else
MsgBox "Relance déjà effectuée!"
End If
End Sub
Sub envoimail()
    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    With OlItem
        .To = "adresse@mail" 'Range("G1").Value
        .Subject = "This will work!" 'Range("C1").Value
        .Body = "This works great, no warning message from Outlook!"
        .Display 'Ou .Send
    End With
End Sub


Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Ok super tu m'as bien débloqué. Maintenant je bloque sur les boucles.
Du coup imaginons que je commence en ligne 2. Donc je pose i = 2.

Le problème c'est que quand j'arrive à la fin i = 3 mais quand je reviens à la 1ère procédure ça remet i = 2 (vu que je l'ai défini comme telle). Je sais pas comment faire pour enchainer les deux procédures en mode boucle.

J'espère que tu vois ce que je veux dire.

Merci d'avance pour ton aide

Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then
Range("K" & i).Select
ActiveCell.FormulaR1C1 = "RELANCE 1"
envoimail1

Else
MsgBox "Relance déjà effectuée!"
End If
Wend
End Sub

Sub envoimail1()
Dim i As Integer
i = 2
While i < 100

    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA pour le BL " & Range("C" & i).Value
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value
        .Display 'Ou .Send
    End With
    i = i + 1
    Testmailauto
    Wend
End Sub 
Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Tu ne trouves pas qu'il y a quelque chose qui cloche:

dans Private Sub Testmailauto()

tu mets : envoimail1

et dans Sub envoimail1()


tu mets : Testmailauto

réfléchis bien à ce que tu veux faire!

normalement dans la sub envoimail1 il n'y a pas a avoir de boucle et de:

Testmailauto
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
D'accord mais il faut bien qu'à la fin de la procédure envoimail1 je lui dise de retourner à la TestMailauto pour qu'elle passe à la cellule K3 non?
Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Et comme ceci:

Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then
Range("K" & i).Select
ActiveCell.FormulaR1C1 = "RELANCE 1"
envoimail1
i= i+1
Else
MsgBox "Relance déjà effectuée!"
End If
Wend
End Sub


en enlevant la boucle et Testmailauto dans envoimail1

Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Private Sub Testmailauto()
Dim i As Integer
i = 2
While i < 100

If Range("K" & i).Value = "" Then

Range("K" & i).Select

ActiveCell.FormulaR1C1 = "RELANCE 1"

envoimail1

i = i + 1

Else
MsgBox "Relance déjà effectuée!"

End If

Wend


End Sub

Sub envoimail1()
Dim i As Integer
Dim Ligne As Long

Ligne = ActiveCell.Row
i = Ligne



    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA pour le BL " & Range("C" & i).Value
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value
        .Display 'Ou .Send
    End With
    
  
End Sub


Voilà où j'en suis maintenant. J'ai mis i = ligne active dans la 2ème procédure ça marche bien. Merci pour ton aide, je suis désolé je débute sur VBA et je t'avoue que les boucles me perdent un peu mais là j'ai mieux compris comment ça fonctionnait.

Le problème c'est que la macro tourne en rond parce quand elle arrive à une cellule K qui n'est pas vide (soit parce que déjà relancé ou parce que rempli) elle ne va pas rechercher à i +1 et reste sur la cellule remplie.

Du coup si je mets i = i+1 après le MsgBox c'est bon mais par contre faut que je lui dise de tout arrêter quand par exemple ActiveCellOffset (0,-1)IsEmpty.

Désolé je galère
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Et encore je dis des bêtises c'est pas grave au pire je ferais un filtre sur les cellules vides pour pas qu'elle rencontre de problèmes. En faite je voudrais juste faire qu'elle s'arrête quand elle rencontre une ligne vide
Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
voir ce site pour les boucles:

https://silkyroad.developpez.com/vba/boucles/#LV

Sub Test_WhileWend()
    Dim i As Integer
    
    i = 1
    
    'Boucle sur les cellules de la colonne A
    'On sort de la boucle si la cellule testée (Cells(i, 1)) est vide
    While Not IsEmpty(Cells(i, 1))
        'Ecrit le contenu de la cellule dans la fenêtre d'exécution.
        Debug.Print Cells(i, 1)
        'Incrémente la variable d'une unité afin de tester la cellule suivante.
        i = i + 1
    Wend
End Sub

Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Je pense que pour ton cas une boucle Do loop serait plus adaptée:

Sub Boucle_V03()
    Dim Trouve As Boolean
    Dim x As Integer
    
    Trouve = False
    x = 2
    Do
        'Boucle tant que le compteur x est inférieur à 100
        Do While x < 100
            'Incrémente le compteur.
            x = x + 1
            'Vérifie le contenu de la cellule.
            If Cells(x, 1) = "" Then
                'Attribue la valeur Vrai si la cellule est trouvée.
                Trouve = True
                'Anticipe la sortie de la boucle.
                Exit Do
            End If
        Loop
    'Quitte la boucle si la variable à la valeur True.
    Loop Until Trouve = True Or x = 100

    'Affiche un message en fonction du résultat de la recherche.
    MsgBox IIf(Trouve = True, "Trouvé ligne " & x, "Pas trouvé")

'  là tu mets ton action
    envoimail1

End Sub

Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Merci, je viens de voir tes réponses, j'essaie de digérer tout ça. Encore merci c'est vraiment super d'avoir des gens comme toi qui aide
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Ca marche plutôt pas mal sauf pour faire arrêter la macro.

Avec ton exemple j'arrive à la stopper si je met par exemple
Loop Until Trouve = True Or x = 5

Mais j'aimerais qu'elle s'arrête seul quand elle rencontre une celulle vide en (x,7).

J'ai donc essayé Loop Until Trouve = True And IsEmptyCells(x,7) mais ça ne marche pas.

Désolé je me sens nul
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
C'est bon excuse moi pour le dérangement enfaite il fallait que je mette

If Trouve = True And Cells(x, 7) <> "" Then
Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Donc voilà pour ceux que ça intéresse voilà le code final qui marche parfaitement.
Merci Le Pivert ;)

Sub Testmailauto1()
Dim Trouve As Boolean
Dim x As Integer

Trouve = False
x = 1

Do
    Do While x < 100
    x = x + 1
    
    If Cells(x, 11) = "" Then
    
    Trouve = True
        
    Exit Do
        
    End If
Loop


Loop Until Trouve = True

If Trouve = True And Cells(x, 7) <> "" Then
Range("K" & x).Select

ActiveCell.FormulaR1C1 = "RELANCE 1 du " & Date

envoimail1
Else
Exit Sub
End If
Testmailauto1
End Sub

Sub envoimail1()
Dim x As Integer
Dim Ligne As Long

Ligne = ActiveCell.Row
i = Ligne



    Set OlApp = CreateObject("Outlook.application")
    Set OlItem = OlApp.CreateItem(olMailItem)
    
    Carrier = Range("G" & i).Value
    Columns("N:N").Select
    Selection.Find(What:=Carrier, After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext).Activate
        
Adresse = ActiveCell.Offset(0, 1).Value
    
    With OlItem
        .To = Adresse
        .Subject = "Demande de LTA "
        .Body = "Bonjour, Merci de me communiquer la LTA pour le transport " & Range("D" & i).Value & " Numéro de BL " & Range("C" & i).Value
        .Display 'Ou .Send
    End With
    
  
End Sub
Messages postés
6830
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
8 juillet 2020
532
Pourquoi as-tu mis?

Testmailauto1

a la fin de ta Sub Testmailauto1()

ATTENTION tu vas avoir une boucle sans fin


Messages postés
68
Date d'inscription
lundi 10 mars 2014
Statut
Membre
Dernière intervention
10 avril 2018
1
Salut à toi,

Ba justement c'est en mettant Call Testmailauto1 que la macro tourne et me fait toutes les lignes.

Sans ça elle restait à End If et ne vérifiait pas toutes mes lignes.

Avec ce code la macro tourne parfaitement et ne fait pas de boucles sans fin.